home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / asm68k.arc / ASM68K.FOR < prev    next >
Encoding:
Text File  |  1985-11-08  |  64.8 KB  |  2,917 lines
  1.     PROGRAM MAIN
  2. C
  3. C    M68000 CROSS-ASSEMBLER MAIN PROGRAM
  4. C
  5. C
  6. C REVISION:
  7. C    X1.0    (EXPERIMENTAL PRE-RELEASE)
  8. C
  9. C AUTHOR:
  10. C    Allen Kossow
  11. C    2909A N. Fredrick
  12. C    Milwaukee, WI 53211
  13. C    Ph (414) 963-5440
  14. C
  15. C    SYMBOLS ARE A MAXIMUM OF EIGHT CHRS IN LENGTH
  16. C    THERE CAN BE UP TO 512 SYMBOLS
  17. C
  18. C
  19. C....    LOGICAL UNIT DEFINITION
  20. C    1 = SOURCE FILE
  21. C    2 = OBJECT FILE
  22. C    3 = LIST   FILE
  23. C    5 = KEYBD
  24. C
  25. C
  26.     IMPLICIT INTEGER (A-Z)
  27.     BYTE NAME(8),SYMFLG(513)
  28. C
  29.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  30. C
  31.     COMMON /SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  32. C
  33.     COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  34.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  35. C
  36.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  37. C
  38.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
  39. C
  40.     COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
  41. C
  42.     COMMON /CNVT  / WORD,PL
  43. C
  44.     COMMON /HEXFLG/ ENDFLG,HEXWC,HEXPC,OLDPC
  45. C
  46.     DIMENSION OBJBUF(40)
  47. C
  48.     INTEGER*4 PC,NEWPC,SYMADR(512),HEXPC,OLDPC
  49. C
  50.     BYTE ERR,SRCLNE(81),LABEL(8),PL(132)
  51. C
  52. C....    TELL FORTRAN TO IGNORE INTEGER OVERFLOWS ON MULTIPLY AND DIVIDE.
  53. C
  54.     ERR=128
  55. C
  56. C....    THE FOLLOWING CALL IS NO OP'ED OUT FOR F4P
  57. C
  58. C    CALL SETERR(1,ERR)
  59. C
  60. C....    INITIALIZE VARIABLES
  61. C
  62. 5    NOPAGE=0
  63.     RFLG=1
  64.     LFLG=1
  65. C
  66. C....    OPEN FILES
  67. C
  68.     CALL SOURCE(1)
  69.     CALL LIST(1)
  70.     CALL OBJECT(1)
  71. C
  72. C....    DO PASS 1
  73. C
  74. 1    NOSYM=0
  75.     PASS=1
  76.     CALL I4CLR(PC)
  77.     DO 10 I=1,8
  78.     NAME(I)=32
  79. 10    CONTINUE
  80. C
  81. C....    READ ONE LINE OF SOURCE FILE
  82. C
  83. 15    CALL I4CLR(NEWPC)
  84.     CALL SOURCE(2)
  85. C
  86. C....    IF EOF DETECTED DO PASS 2
  87. C
  88.     IF(ISERR.EQ.1) GOTO 20
  89. C
  90. C....    RESET MULTIPLE ERROR FLG
  91. C
  92.     MEFLG = 0
  93. C
  94. C....    PARSE SOURCE LINE
  95. C
  96.     CALL PARSE
  97. C
  98. C....    IF NULL LINE GET NEXT LINE
  99. C
  100.     IF(PRFLG.EQ.0) GOTO 15
  101. C
  102. C....    PROCESS SOURCE LINE
  103. C
  104.     CALL PRCESS
  105. C
  106. C....    IF END DETECTED DO PASS 2 ELSE GET NEXT LINE
  107. C
  108.     IF(ISERR.EQ.1) GOTO 20
  109.     I=JADD(PC,NEWPC,PC)
  110.     GOTO 15
  111. C
  112. C....    DO PASS 2
  113. C
  114. C
  115. C....    REW SOURCE SET TO PASS 2 AND RESET PC
  116. C
  117. 20    CALL SOURCE(3)
  118.     PASS=2
  119.     IERCNT = 0
  120.     CALL I4CLR(PC)
  121.     CALL I4CLR(HEXPC)
  122.     CALL I4CLR(OLDPC)
  123. C
  124. C....    FLUSH PRINT BUFFER IN CASE ANYTHING LEFT
  125. C....    FROM LAST ASSEMBLY
  126. C
  127.     DO 25 I=1,132
  128. 25    PL(I) = "40
  129. C
  130. C....    INITIALIZE OBJECT BUFFER
  131. C
  132.     ENDFLG = 0
  133.     HEXWC  = 0
  134. C
  135. C....    PRINT FIRST PAGE HEADING
  136. C
  137.     CALL NEWPAG
  138. 30    CALL I4CLR(NEWPC)
  139.     OBJWC = 0
  140.     CALL SOURCE(2)
  141. C
  142. C....    EOF DETECTED
  143. C
  144.     IF(ISERR.EQ.1) GOTO 50
  145. C
  146. C....    RESET MULTIPLE ERROR FLG
  147. C
  148.     MEFLG = 0
  149. C
  150. C....    PARSE LINE
  151. C
  152.     CALL PARSE
  153. C
  154. C....    PRINT A LINE OF ONLY COMMENTS NORMALLY
  155. C
  156.     IF(CMTPTR.EQ.1) GOTO 40
  157. C
  158. C....    CHECK FOR PARSING ERRORS
  159. C
  160.     IF(PRFLG.EQ.0) GOTO 30
  161. C
  162. C....    PROCESS IT
  163. C
  164. 38    CALL PRCESS
  165. C
  166. C....    GENERATE LISTING
  167. C
  168. 40    CALL LSTLNE
  169. C
  170. C....    CHECK IF THERE IS OBJ CODE TO GENERATE
  171. C
  172.     IF(OBJWC.EQ.0) GOTO 45
  173.     CALL BLDOBJ
  174. C
  175. C....    DO NEXT LINE IF NOT END
  176. C
  177. 45    IF(ISERR.EQ.1) GOTO 50
  178.     I=JADD(PC,NEWPC,PC)
  179.     GOTO 30
  180. C
  181. C....    END OF ASSEMBLY, OUTPUT BALANCE OF OBJ BUFFER
  182. C
  183. 50    ENDFLG = 1
  184.     CALL BLDOBJ
  185. C
  186. C....    PRINT SYMBOL TABLE
  187. C
  188.     CALL PST
  189. C
  190. C....    CLOSE FILES AND DO IT AGAIN
  191. C
  192.     CALL SOURCE(4)
  193.     CALL LIST(2)
  194.     CALL OBJECT(2)
  195.     GOTO 5
  196.     END
  197.     SUBROUTINE SOURCE(ICODE)
  198. C
  199. C PERFORMS ALL OPERATIONS OF SOURCE INPUT FILE
  200. C
  201. C INPUT:
  202. C ICODE = 1 => OPEN SOURCE FILE (NAME READ FROM KEYBOARD)
  203. C         2 => READ ONE LINE FROM SOURCE FILE INTO
  204. C             'SRCLNE' (80R1 FORMAT). TRAILING BLANKS
  205. C              ARE DELETED. ZERO CHAR IS INSERTED AT
  206. C              THE END OF THE LINE.
  207. C         3 => REWIND SOURCE FILE.
  208. C         4 => CLOSE SOURCE FILE.
  209. C
  210. C OUTPUT:
  211. C    SRCLNE = SOURCE LINE FOR CODE 2
  212. C    LNELEN = LENGTH OF LINE FOR CODE 2
  213. C    ISERR  = 1 IF END OF FILE ON READ (ZERO OTHERWISE)
  214. C    NOCARD = CARD NUMBER READ FROM SOURCE (1-?)
  215. C
  216.     BYTE FILNAM(12)
  217.     BYTE SRCLNE(81)
  218.     COMMON/SRC/LNELEN,ISERR,NOCARD,SRCLNE
  219.     COMMON /FNAM/ FILNAM,OBJFLG
  220. C
  221. C SELECT FUNCTION
  222. C
  223.     GO TO (100,200,300,400),ICODE
  224. C
  225. C OPEN SOURCE FILE
  226. C
  227. 100    TYPE 110
  228. 110    FORMAT('$Src file name: ')
  229.     READ (5,120) ICNT,FILNAM
  230. 120    FORMAT(Q,12A1)
  231.     IF(ICNT.EQ.0) STOP
  232.     CALL ASSIGN(1,FILNAM,ICNT)
  233.     NOCARD=0
  234.     GOTO 500
  235. C
  236. C READ SOURCE LINE
  237. C
  238. 200    ISERR=0
  239.     READ(1,210,END=250) (SRCLNE(I),I=1,80)
  240. 210    FORMAT(80A1)
  241.     NOCARD=NOCARD+1
  242. C
  243. C CONVERT ALL CHARACTERS
  244. C
  245.     DO 225 I=1,80
  246.     IF(SRCLNE(I).GE.32) GO TO 220
  247. 215    SRCLNE(I)=32
  248.     GO TO 225
  249. 220    IF(SRCLNE(I).LT.96) GO TO 225
  250.     SRCLNE(I)=SRCLNE(I)-32
  251.     IF(SRCLNE(I).GE.96) GO TO 215
  252. 225    CONTINUE
  253. C
  254. C REMOVE TRAILING BLANKS
  255. C
  256.     LNELEN=80
  257. 230    IF(SRCLNE(LNELEN).NE.32) GO TO 240
  258.     LNELEN=LNELEN-1
  259.     IF(LNELEN.GT.0) GO TO 230
  260. 240    LNELEN=LNELEN+1
  261.     SRCLNE(LNELEN)=0
  262.     GO TO 500
  263. C
  264. C END OF FILE
  265. C
  266. 250    ISERR=1
  267.     GO TO 500
  268. C
  269. C REWIND SOURCE FILE
  270. C
  271. 300    REWIND 1
  272.     NOCARD=0
  273.     GO TO 500
  274. C
  275. C CLOSE SOURCE FILE
  276. C
  277. 400    CLOSE(UNIT=1)
  278. 500    RETURN
  279.     END
  280.     SUBROUTINE LIST(LCODE)
  281. C
  282. C PERFORMS OPEN AND CLOSE ON LIST FILE
  283. C
  284. C INPUT:LCODE = 1 => OPEN FILE (NAME READ FROM KEYBOARD)
  285. C               2 => CLOSE FILE
  286. C
  287.     BYTE FILNAM(12)
  288.     INTEGER PASS
  289.     BYTE NAME(8)
  290. C
  291.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  292. C
  293.     COMMON /FNAM/ FILNAM,OBJFLG
  294. C
  295. C SELECT FUNCTION
  296. C
  297.     GO TO (100,200),LCODE
  298. C
  299. C....    ASSIGN DEFAULT LISTING TO CONSOLE
  300. C
  301. 100    LUNIT=5
  302.     TYPE 110
  303. 110    FORMAT('$Lst file name: ')
  304.     READ (5,115) ICNT,FILNAM
  305. 115    FORMAT(Q,12A1)
  306.     IF(ICNT.EQ.0) GOTO 116
  307. C
  308. C....    IF THERE IS A FILENAME ASSIGN LISTING TO LUN 3
  309. C
  310.     LUNIT = 3
  311.     CALL ASSIGN(LUNIT,FILNAM,ICNT)
  312. 116    NOPAGE=0
  313.     GO TO 300
  314. C
  315. C CLOSE FILE
  316. C
  317. 200    IF(LUNIT.EQ.5) RETURN
  318.     CALL CLOSE(LUNIT)
  319. 300    RETURN
  320.     END
  321.     SUBROUTINE OBJECT(ICODE)
  322. C
  323. C PERFORMS OPEN AND CLOSE ON OBJECT FILE
  324. C
  325.     BYTE FILNAM(12)
  326.     INTEGER PASS
  327.     BYTE NAME(8)
  328.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  329.     COMMON /FNAM/ FILNAM,OBJFLG
  330.     GOTO (100,200),ICODE
  331. 100    TYPE 110
  332. 110    FORMAT ('$Obj file name: ')
  333.     READ (5,115) ICNT,FILNAM
  334. 115    FORMAT(Q,12A1)
  335.     IF(ICNT .EQ.0) GOTO 116
  336.     CALL ASSIGN(2,FILNAM,ICNT)
  337.     OBJFLG = 1
  338.     RETURN
  339. 116    OBJFLG = 0
  340.     RETURN
  341. 200    IF(OBJFLG.EQ.0) RETURN
  342.     CALL CLOSE(2)
  343.     RETURN
  344.     END
  345.     SUBROUTINE SYMTBL(ICODE,IADDR,SYMSTR)
  346. C
  347. C SYMBOL TABLE PROCESSOR
  348. C
  349. C INPUT:
  350. C       ICODE = 1 => FIND OPERAND IN SYMBOL TABLE.  IF NOT FOUND,
  351. C                    IT IS ENTERED INTO THE TABLE AS REFERENCED
  352. C                    BUT NOT DEFINED.  THE INDEX OF THE SYMBOL
  353. C                    IN THE SYMBOL IS RETURNED IN 'STIND'.
  354. C
  355. C               2 => FIND LABEL IN SYMBOL TABLE.  IF FOUND AND ALREADY
  356. C                    DEFINED AND THIS IS THE FIRST PASS OF THE
  357. C                    ASSEMBLER, THE MULTIPLE DEFINED BIT IS SET IN
  358. C                    SYMFLG.  IF FOUND BUT ONLY PREVIOUSLY REFERENCED,
  359. C                    THE DEFINED BUT PREVIOUSLY REFERENCED BIT IS SET
  360. C                    AND THE REFERENCED BIT IS CLEARED.  IF NOT FOUND,
  361. C                    IT IS ENTERED AND THE DEFINED BIT IS SET.
  362. C
  363. C       IADDR =      ADDRESS OF SYMBOL FOR ENTERING INTO SYMBOL TABLE.
  364. C       SYMBOL=      SYMBOL TO LOOK UP OR ENTER IN SYMBOL TABLE.
  365. C
  366. C OUTPUT:
  367. C       STIND = INDEX INTO SYMBOL TABLE FOR SYMBOL.
  368. C
  369. C FORMAT OF 'SYMFLG':
  370. C
  371. C BIT   MEANING IF SET
  372. C  0    SYMBOL HAS BEEN REFERENCED BUT NOT DEFINED.
  373. C  1    SYMBOL HAS BEEN DEFINED AND WAS REFERENCED BEFORE DEFINITION.
  374. C  2    SYMBOL HAS BEEN DEFINED AND THERE WERE NO REFERENCES BEFORE.
  375. C  3    SYMBOL HAS BEEN MULTIPLE DEFINED.
  376. C  4    SYMBOL IS AN EQUATED VALUE
  377. C
  378.     IMPLICIT INTEGER (A-Z)
  379.     BYTE SYMFLG(513),SYMSTR(8),SRCLNE(81)
  380.     DIMENSION SYMSYM(4,512),SYMBOL(4),SYMLIN(512)
  381.     INTEGER*4 SYMADR(512),IADDR
  382.     INTEGER*4 PC,NEWPC
  383.     COMMON/SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  384.     BYTE NAME(8)
  385.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  386.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  387.     COMMON/SYMN/SYMSYM,SYMLIN
  388. C
  389. C    PACK SYMBOL TWO BYTES TO A WORD
  390. C
  391.     DO 100 J=1,4
  392.     I = J*2
  393. 100    SYMBOL(J) = ((SYMSTR(I-1)*256).OR.SYMSTR(I))
  394. C
  395. C    SEARCH FOR SYMBOL IN SYMBOL TABLE
  396. C
  397.     STIND  = 1
  398.     MOVFLG = 0
  399.     IF(NOSYM.EQ.0) GO TO 200
  400.     DO 120 STIND=1,NOSYM
  401.     DO 110 J=1,4
  402.     IF(SYMSYM(J,STIND).NE.SYMBOL(J)) GO TO 115
  403. 110    CONTINUE
  404.     GO TO 300
  405. 115    DO 118 J=1,4
  406.     IF (SYMSYM(J,STIND).LT.SYMBOL(J)) GOTO 120
  407.     IF (SYMSYM(J,STIND).EQ.SYMBOL(J)) GOTO 118
  408.     MOVFLG = 1
  409.     GOTO 200
  410. 118    CONTINUE
  411. 120    CONTINUE
  412. C
  413. C SYMBOL WAS NOT FOUND
  414. C
  415. 200    IF(NOSYM.LT.513) GO TO 210
  416.     CALL ERROR(221)
  417.     STIND=513
  418.     GOTO 400
  419. 210    IF (MOVFLG.EQ.0) GOTO 218
  420.     ITEMP = NOSYM
  421. 211    DO 212 J=1,4
  422. 212    SYMSYM(J,ITEMP+1) = SYMSYM(J,ITEMP)
  423.     CALL JMOV (SYMADR(ITEMP),SYMADR(ITEMP+1))
  424.     SYMFLG(ITEMP+1) = SYMFLG(ITEMP)
  425.     SYMLIN(ITEMP+1) = SYMLIN(ITEMP)
  426.     ITEMP = ITEMP - 1
  427.     IF (ITEMP.GE.STIND) GOTO 211
  428. 218    NOSYM = NOSYM + 1
  429.     DO 220 J = 1,4
  430. 220    SYMSYM (J,STIND) = SYMBOL(J)
  431.     IF(ICODE.EQ.1) GO TO 250
  432.     SYMFLG(STIND)=4
  433.     CALL I4CLR(SYMADR(STIND))
  434.     I=JADD(SYMADR(STIND),IADDR,SYMADR(STIND))
  435.     SYMLIN(STIND) = NOCARD
  436.     GOTO 400
  437. 250    CALL I4CLR(SYMADR(STIND))
  438.     SYMFLG(STIND)=1
  439.     SYMLIN(STIND) = 0
  440.     GOTO 400
  441. C
  442. C SYMBOL FOUND
  443. C
  444. 300    IF(PASS.EQ.2.OR.ICODE.EQ.1) GOTO 400
  445.     IF(SYMFLG(STIND).NE.1) GO TO 310
  446.     SYMFLG(STIND)=2
  447.     CALL I4CLR(SYMADR(STIND))
  448.     I=JADD(SYMADR(STIND),IADDR,SYMADR(STIND))
  449.     SYMLIN(STIND) = NOCARD
  450.     GOTO 400
  451. 310    SYMFLG(STIND)=SYMFLG(STIND).OR.8
  452. 400    RETURN
  453.     END
  454.     SUBROUTINE CNVHEX(INDEX)
  455. C
  456. C CONVERTS 4 BITS TO HEX ASCII AND INSERTS INTO 'PL' AT 'INDEX'
  457. C
  458. C INPUT: WORD = VALUE
  459. C        INDEX= WHERE TO INSERT IN PL
  460. C
  461. C OUTPUT:
  462. C        WORD = WORD/16
  463. C
  464.     BYTE PL(132),DIG
  465.     INTEGER WORD
  466.     COMMON /CNVT/ WORD,PL
  467.     CALL GETBIT(WORD,DIG)
  468.     PL(INDEX)=DIG
  469.     RETURN
  470.     END
  471.     SUBROUTINE INSDAT(IPL,IDIG)
  472. C
  473. C CONVERTS BINARY DATA TO HEX ASCII AND INSERTS INTO 'PL'
  474. C
  475. C INPUT:IPL = INDEX TO INSERT INTO PL
  476. C       IDIG= NUMBER OF DIGITS TO CONVERT AND INSERT
  477. C       WORD= VALUE TO CONVERT (IN COMMON - NOT REFERENCED HERE)
  478. C
  479.     I=IDIG
  480. 5    J=IPL+I-1
  481.     CALL CNVHEX(J)
  482.     I=I-1
  483.     IF(I.LE.0) RETURN
  484.     GO TO 5
  485.     END
  486.  
  487.     SUBROUTINE IHX(ISZ,IDTA,IPPOS)
  488. C
  489. C PRINT A 4 OR 8 DIGIT HEX VALUE
  490. C NUMBER OBTAINED STARTING AT 'WORD'
  491. C AND PUT INTO PRINT BUFFER 'PL' STARTING IN COL 1
  492. C
  493.     IMPLICIT INTEGER (A-Z)
  494.     COMMON /CNVT/ WORD,PL
  495.     COMMON /LST/LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  496.     BYTE PL(132),NAME(8)
  497.     DIMENSION IDTA(3)
  498.     PL(1)=32
  499.     IF(ISZ.EQ.2) GOTO 15
  500.     WORD=IDTA(1)
  501.     CALL INSDAT(IPPOS,4)
  502.     RETURN
  503. 15    WORD=IDTA(2)
  504.     CALL INSDAT(IPPOS,4)
  505.     WORD=IDTA(1)
  506.     CALL INSDAT(IPPOS+4,4)
  507.     RETURN
  508.     END
  509.  
  510.     SUBROUTINE PST
  511. C
  512. C SORT AND PRINT SYMBOL TABLE
  513. C
  514.     INTEGER PASS,STIND,SYMLIN(512)
  515.     INTEGER*4 PC,NEWPC,SYMADR(512)
  516.     BYTE NAME(8),SYMSYM(8,512),SYMFLG(513),PL(132)
  517.     COMMON/LST/LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  518.     COMMON/SYMN/SYMSYM,SYMLIN
  519.     COMMON/SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  520.     COMMON /CNVT/ WORD,PL
  521.     IF(NOSYM.EQ.0) RETURN
  522. C
  523. C    START OUT WITH CLEAN BUFFER
  524. C
  525.     DO 50 I = 1,132
  526. 50    PL(I) = "40
  527. C
  528. C GOTO TOP OF PAGE
  529. C
  530.     CALL NEWPAG
  531. C
  532. C    GENERATE THE SYMBOL LIST A LINE AT A TIME
  533. C
  534.     DO 300 I = 1,NOSYM,5
  535.     DO 210 IDX=0,4
  536.     IF (I+IDX.GT.NOSYM) GOTO 290
  537.     DO 170 IPT=1,7,2
  538.     PL(IPT+(IDX*24)+1) = SYMSYM(IPT,(I+IDX))
  539. 170    PL(IPT+(IDX*24)) = SYMSYM(IPT+1,(I+IDX))
  540.     CALL IHX(2,SYMADR(I+IDX),(IDX*24)+12)
  541.     IFTMP = SYMFLG(I+IDX)
  542.     IF ((IFTMP.AND.16).NE.16 ) GOTO 180
  543.     PL((IDX*24)+19) = 'E'
  544.     PL((IDX*24)+20) = 'Q'
  545. 180    IF ((IFTMP.AND.8).NE.8  ) GOTO 190
  546.     PL((IDX*24)+19) = 'M'
  547.     PL((IDX*24)+20) = 'U'
  548. 190    IF ((IFTMP.AND.1).NE.1) GOTO 200
  549.     PL((IDX*24)+19) = 'U'
  550.     PL((IDX*24)+20) = 'N'
  551. 200    IF ((IFTMP.AND."31).NE.0) GOTO 210
  552.     PL((IDX*24)+19) = ' '
  553.     PL((IDX*24)+20) = ' '
  554. 210    CONTINUE
  555. 290    WRITE (LUNIT,400) (PL(N),N=1,IDX*24)
  556.     NOLINE = NOLINE -1
  557.     CALL PAGCHK
  558. 300    CONTINUE
  559. 400    FORMAT (' ',132A1)
  560.     WRITE (LUNIT,410) NOSYM,IERCNT
  561. 410    FORMAT (/,' ',I3,' SYMBOLS , ',I3,' ERRORS DETECTED')
  562.     IF (LUNIT.EQ.5) RETURN
  563.     WRITE (5,410)     NOSYM,IERCNT
  564.     RETURN
  565.     END
  566.     SUBROUTINE NEWPAG
  567.     IMPLICIT INTEGER (A-Z)
  568. C
  569. C PUTS OUT HEADERS AT TOP OF EACH PAGE
  570. C
  571.     INTEGER PASS
  572.     BYTE NAME(8),FF
  573.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  574.     FF="14
  575.     NOPAGE=NOPAGE+1
  576.     NOLINE = 57
  577.     IF(NOPAGE.EQ.1) FF = 0
  578.     WRITE(LUNIT,10)FF,NAME,NOPAGE
  579. 10    FORMAT(' ',1A1,8A1,T28,'M68000 CROSS-ASSEMBLER X1.0
  580.      +',T83,'PAGE ',I3,/)
  581.     RETURN
  582.     END
  583.     SUBROUTINE PAGCHK
  584.     IMPLICIT INTEGER (A-Z)
  585. C
  586. C CHECKS TO SEE IF A PAGE HAS BEEN FILLED
  587. C
  588.     BYTE NAME(8)
  589.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  590.     IF(NOLINE.EQ.0) CALL NEWPAG
  591.     RETURN
  592.     END
  593.     SUBROUTINE ERROR(IERR)
  594.     IMPLICIT INTEGER(A-Z)
  595. C
  596. C    AND PRINTS ERROR MESSAGE DURING PASS 2
  597. C
  598.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  599.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  600.     COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  601.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  602.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
  603.     DIMENSION OBJBUF(40)
  604.     COMMON /SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  605.     INTEGER*4 PC,NEWPC,SYMADR(512)
  606.     LOGICAL*1 SYMFLG(513),ERRPTR(80),NAME(8),SRCLNE(81)
  607.     LOGICAL*1 LABEL(8)
  608. C
  609. C....    ERRORS ARE IGNORED DURING THE FIRST PASS
  610. C
  611.     IF(PASS.EQ.1) RETURN
  612. C
  613.     PRFLG  = 3
  614. C
  615. C....    WE NEED AT LEAST THREE LINES TO PRINT AN BAD LINE
  616. C
  617.     IF(NOLINE.LE.2) NOLINE = 0
  618.     CALL PAGCHK
  619. C
  620. C....    IF THIS IS NOT THE FIRST ERROR THEN DON'T PRINT THE LINE
  621. C
  622.     IF (MEFLG.EQ.1) GOTO 15
  623.     WRITE(LUNIT,10) NOCARD,(SRCLNE(I),I=1,LNELEN-1)
  624. 10    FORMAT(' ',/,' ',I4,35X,80A1:)
  625.     NOLINE = NOLINE - 2
  626. 15    DO 20,I=1,SCANPT
  627. 20    ERRPTR(I)="40
  628.     ERRPTR(I)="136
  629.     WRITE(LUNIT,30) IERR,(ERRPTR(I),I=1,SCANPT+1)
  630. 30    FORMAT(' ++++  ERROR    ',I3,20X,80A1:)
  631.     NOLINE = NOLINE - 1
  632.     IERCNT = IERCNT + 1
  633.     MEFLG = 1
  634.     RETURN
  635.     END
  636.     SUBROUTINE LSTLNE
  637.     IMPLICIT INTEGER (A-Z)
  638. C
  639. C    BUILD LINE (OR LINES IF DC.B DC.W DC.L)
  640. C    FOR DISPLAY
  641. C
  642.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  643. C
  644.     COMMON /CNVT/ WORD,PL
  645. C
  646.     COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  647. C
  648.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
  649. C
  650.     COMMON /SYMT/ STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  651. C
  652.     COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  653.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  654. C
  655.     INTEGER*4 PC,NEWPC,SYMADR(512)
  656.     DIMENSION OBJBUF(40)
  657.     BYTE SYMFLG(513),NAME(8),LABEL(8),SRCLNE(81),PL(132)
  658.     DATA PL/132*"40/
  659. C
  660. C       PRFLG = 0    ERRORS DETECTED (PRINT LINE AS READ)
  661. C               1    NO ERRORS DETECTED (PRINT NORMALLY)
  662. C               2    DC.W  / DC.L DIRECTIVES
  663. C               3    SUPRESS PRINTOUT OF LINE
  664. C               4    DC.B DIRECTIVE
  665. C               5    NAM / END / MON DIRECTIVES
  666. C               6    EQU / SET DIRECTIVES
  667. C               7    ORG / RORG DIRECTIVES
  668. C               8    DS   DIRECTIVE
  669. C               9    PAGE DIRECTIVE
  670. C
  671. C
  672. C
  673. C    IF THIS IS THE FIRST PASS, THEN DONT PRINT ANYTHING
  674. C
  675.     IF (PASS.EQ.1) RETURN
  676. C
  677. C    IF CODE IS LONGER THAN FIVE WORDS THEN
  678. C    ONLY PRINT 5 WORDS OF AN INSTRUCTION
  679. C
  680.     LSWRDS = OBJWC
  681.     IF(OBJWC.GT.5) LSWRDS=5
  682. C
  683. C    CHECK IF WE HAVE TO GO TO NEXT PAGE
  684. C
  685.     CALL PAGCHK
  686. C
  687. C
  688.     IF(CMTPTR.NE.1)GOTO 80
  689.     OPPTR=1
  690.     GOTO 220
  691. 80    GOTO (200,200,200,410,500,600,200,200,200,400),PRFLG+1
  692. 200    CALL IHX(2,PC,7)
  693. C
  694. C
  695.     IF(LSWRDS.EQ.0) GOTO 212
  696. 205    DO 210,I=1,LSWRDS
  697. 210    CALL IHX(1,OBJBUF(I),11+(5*I))
  698. C
  699. C
  700. 212    IF(LABEL(1).EQ.0) GOTO 220
  701.     DO 215,I=1,8
  702. 215    PL(I+40)=LABEL(I)
  703. 220    J=0
  704.     DO 230 I=OPPTR,LNELEN
  705.     PL(J+50)=SRCLNE(I)
  706.     IF(SRCLNE(I).EQ."40) GOTO 240
  707. 230    J=J+1
  708.     GOTO 1000
  709. 240    III=0
  710.     DO 250 II=I+1,LNELEN
  711.     IF (II.EQ.CMTPTR) III = 25
  712.     PL(57+III)=SRCLNE(II)
  713.     III = III + 1
  714. 250    IF ((III + 57).GT.132) GOTO 255
  715.     GOTO 1000
  716. 255    PL(132) = 0
  717.     GOTO 1000
  718. C
  719. C    PRFLG = 3  (NEW PAGE)
  720. C
  721. 400    CALL NEWPAG
  722. 410    RETURN
  723. C
  724. C
  725. 500    GOTO 205
  726. C
  727. C
  728. 600    GOTO 220
  729. C
  730. C
  731. 700    CALL IHX(2,OBJBUF(2),16)
  732.     GOTO 212
  733. C
  734. C
  735. 1000    DO 1001 I=48,132
  736. 1001    IF(PL(I).EQ.0)GOTO 1002
  737. 1002    WRITE(LUNIT,1110) NOCARD,(PL(II),II=6,I-1)
  738. 1110    FORMAT(' ',I4,132A1)
  739.     DO 1120 II = 1,I
  740. 1120    PL(II) = "40
  741.     NOLINE = NOLINE - 1
  742.     RETURN
  743.     END
  744.  
  745.     SUBROUTINE BLDOBJ
  746.     IMPLICIT INTEGER (A-Z)
  747. C
  748. C    BUILD OBJ FILE
  749. C
  750.     COMMON /FNAM  / FILNAM,OBJFLG
  751. C
  752.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
  753. C
  754.     COMMON /CNVT  / WORD,PL
  755. C
  756.     COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  757. C
  758.     COMMON /HEXFLG/ ENDFLG,HEXWC,HEXPC,OLDPC
  759. C
  760.     DIMENSION OBJBUF(40),HEXBUF(8)
  761.     INTEGER*4 PC,NEWPC,SYMADR(512),OLDPC,NEWVAL,HEXPC
  762.     LOGICAL*1 SYMFLG(513),PL(132),FILNAM(12)
  763. C
  764. C    CHECK IF OBJ FILE IS TO BE GENERATED
  765. C
  766.     IF (OBJFLG.EQ.0) RETURN
  767. C
  768. C    CHECK FOR THE END OF ASSEMBLY FLAG
  769. C    IF IT IS SET, WRITE OUT THE BALANCE OF THE OBJ BUFFER
  770. C
  771.     IF (ENDFLG.EQ.0) GOTO 10
  772.     IF (HEXWC.NE.0)  CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
  773.     RETURN
  774. C
  775. C    CHECK THE CURRENT VALUE OF THE PC WITH THAT OF THE ONE SAVED
  776. C    IF THE TWO ARE NOT EQUAL, THEN WRITE OUT THE BALANCE OF THE
  777. C    OBJ BUFFER AND START AT THE NEW PC VAL
  778. C
  779. 10    CALL DBLSGL(PC,PC1,PC2)
  780.     CALL DBLSGL(OLDPC,OLDPC1,OLDPC2)
  781.     IF (PC1.NE.OLDPC1) GOTO 50
  782.     IF (PC2.EQ.OLDPC2) GOTO 75
  783. 50    IF (HEXWC.NE.0) CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
  784.     CALL JMOV(PC,HEXPC)
  785.     CALL JMOV(PC,OLDPC)
  786. C
  787. C    EXTRACT OBJECT WORDS FROM OBJECT BUFFER AND
  788. C    PUT THEM INTO AN INTERNAL BUFFER. IF THE
  789. C    INTERNAL BUFFER IS FULL, THEN OUTPUT THE BUFFER.
  790. C
  791. 75    I = 1
  792. 76    HEXWC = HEXWC + 1
  793.     HEXBUF(HEXWC) = OBJBUF(I)
  794.     IF (HEXWC.NE.8) GOTO 99
  795. C
  796. C....    OBJECT BUFFER IS FULL, OUTPUT IT TO OBJ FILE
  797. C
  798.     CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
  799. C
  800. C    CALCULATE NEW STARTING PC FOR HEX BUFFER
  801. C
  802.     N = JICVT(I*2,NEWVAL)
  803.     N = JADD(PC,NEWVAL,HEXPC)
  804. 99    I = I + 1
  805.     IF (I.LE.OBJWC) GOTO 76
  806. C
  807. C    CALCULATE WHAT THE NEW PC SHOULD BE BY ADDING
  808. C    THE OBJECT WORD COUNT TO THE CURRENT PC
  809. C
  810.     I = JADD(OLDPC,NEWPC,OLDPC)
  811.     RETURN
  812.     END
  813.     SUBROUTINE WRTOBJ(HEXPC,HEXWC,HEXBUF)
  814.     IMPLICIT INTEGER(A-Z)
  815. C
  816. C    OUTPUT THE CONTENTS OF THE OBJECT BUFFER
  817. C
  818. C    HEXPC = STARTING PC FOR BUFFER
  819. C    HEXWC = NUMBER OF WORDS USED IN BUFFER
  820. C    HEXBUF= 8 WORD OBJECT BUFFER
  821. C
  822.     COMMON /CNVT/ WORD,PL
  823.     LOGICAL*1 PL(132)
  824.     INTEGER*4 HEXPC
  825.     DIMENSION HEXBUF(8)
  826.     DO 10, I = 1,80
  827. 10    PL(I) = "40
  828.     CALL IHX(2,HEXPC,1)
  829.     PLIDX = 10
  830.     DO 20,I=1,HEXWC
  831. 20    CALL IHX(1,HEXBUF(I),PLIDX+(5*(I-1)))
  832.     WRITE (2,100)(PL(I),I=3,10+(5*HEXWC))
  833. 100    FORMAT(' ',80A1)
  834.     HEXWC = 0
  835.     DO 900, I = 1,80
  836. 900    PL(I) = "40
  837.     RETURN
  838.     END
  839.      SUBROUTINE PRCESS
  840. C
  841. C    PROCESSES SOURCE LINE AFTER IT HAS BEEN PARSED BY PARSE
  842. C
  843. C INPUT:PARSE OUTPUTS
  844. C
  845. C OUTPUT:
  846. C
  847. C  OBJWC    NUMBER OF WORDS REQUIRED FOR INSTRUCTION
  848. C
  849. C  OBJBUF   TABLE OF WORDS GENERATED
  850. C
  851. C  PRFLG 0  ERRORS DETECTED (PRINT LINE AS READ
  852. C        1  NO ERRORS DETECTED (PRINT NORMALLY)
  853. C        2  DC.W/DC.L DIRECTIVES
  854. C        3  DONT PRINT LINE
  855. C        4  DC.B DIRECTIVE
  856. C        5  NAM/END/MON DIRECTIVES
  857. C        6  EQU/SET DIRECTIVE
  858. C        7  ORG/RORG DIRECTIVE
  859. C        8  DS DIRECTIVE
  860. C        9  PAGE DIRECTIVE
  861. C
  862. C  NEWPC    NEW VALUE FOR PC
  863. C
  864. C
  865. C  OP1EA 0  NOT REG OR IMMEDIATE DATA
  866. C        1  D REG
  867. C        2  A REG
  868. C        3  (AN)
  869. C        4  (AN)+
  870. C        5  -(AN)
  871. C        6  # DATA
  872. C        7  SR
  873. C        8  CCR
  874. C        9  USP
  875. C        10 ERROR DETECTED
  876. C
  877. C  IMODE 0  NO SIZE SPECIFIED (DEFAULT IS WORD)
  878. C        1  .B
  879. C        2  .W
  880. C        3  .L
  881. C        4  .S  (SHORT BRANCH)
  882. C
  883. C       ERRORS DEFINED.....
  884. C
  885. C    400    UNDEFINED OPCODE
  886. C    401    OPERAND MISSING FOR OPCODE
  887. C    402    NO ORG SPECIFIED FOR ORG INSTRUCTION
  888. C    403    ERROR IN DC OPN VALUE
  889. C    406    GENERAL ERROR IN DECODING
  890. C    407    UNDEFINED SYMBOL
  891. C    408    ERROR IN SIZE OF Y(Ax,Rx) INDEX
  892. C    409    MULT DEFN SYMBOL
  893. C
  894.     IMPLICIT INTEGER (A-Z)
  895. C
  896.     COMMON /OPWD  / OPNFLG,OPNWC,OPNWRD
  897. C
  898.     COMMON /LST   / LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  899. C
  900.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,BRFLG
  901. C
  902.     COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
  903. C
  904.     COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  905. C
  906.     COMMON /PRSE  / OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  907.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  908. C
  909.     COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
  910. C
  911.     INTEGER*4 PC,NEWPC,SYMADR(512),SYMVAL,TMPVAL,J2
  912.     LOGICAL*1 SRCLNE(81),LABEL(8),NAME(8),SYMFLG(513)
  913.     DIMENSION OBJBUF(40),OPNWRD(3)
  914. C
  915. C....    SET UP FLAGS THAT CHANGE EACH TIME THRU
  916. C
  917.     CALL I4CLR(NEWPC)
  918.     J2     = 2
  919.     OP1EA  = 0
  920.     OP2EA  = 0
  921.     OP1DA  = 0
  922.     OP2DA  = 0
  923.     OPNWC = 0
  924. C
  925. C....    DECODE OPCODE
  926. C
  927.     CALL DECOPC
  928.     IF(OPTYP.NE.0) GOTO 10
  929.     CALL ERROR(400)
  930.     RETURN
  931. C
  932. C....    SKIP IF NO OPERANDS
  933. C
  934. 10    IF(OPNPTR.EQ.0)GOTO 20
  935. C
  936. C....    DECODE FIRST OPERAND
  937. C
  938.     OP1EA=OPNPTR
  939.     CALL EATYP(OP1EA,OP1DA)
  940.     IF(OPNPT2.EQ.0)GOTO 20
  941. C
  942. C....    DECODE SECOND OPERAND
  943. C
  944.     OP2EA=OPNPT2
  945.     CALL EATYP(OP2EA,OP2DA)
  946. C
  947. C....    CHECK FOR OPERANDS
  948. C
  949. 20    IF(OP1EA.EQ.10.OR.OP2EA.EQ.10) GOTO 8500
  950.     IF(OPTYP.EQ.1.OR.OPTYP.EQ.2) GOTO 90
  951.     IF(OPNPTR.NE.0) GOTO 90
  952.     CALL ERROR(401)
  953.     RETURN
  954. C
  955. C....    DEFAULT SIZE IS ONE WORD FOR INSTRUCTIONS
  956. C
  957. 90    OBJWC=1
  958. C
  959. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  960. C
  961. C GOTO OPCODE EVALUATION ROUTINES VIA OPTYPE
  962. C
  963. C ++++++++++++++++++++++++++++++++++++++++++++++++++ 
  964.     GOTO(100,200,300,500,400,600,700,800,900,1000
  965.      +,1100,1200,1300,1400,1500,1600,1700,1800,1900,2000,2100),OPTYP
  966. C
  967. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  968. C
  969. C    PROCESS PSEUDO OPS
  970. C
  971. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  972. C
  973. C....    PSEUDO OPS NORMALLY DON'T GENERATE CODE
  974. C....    THE EXECEPTION BEING 'DC'
  975. C
  976. 100    OBJWC=0
  977.     GOTO(110,120,130,140,150,195,150,160,170,180,190),OPIDX
  978. C
  979. C    DC
  980. C
  981. 110    PRFLG=2
  982.     IFLG = RFLG
  983.     RFLG = 1
  984. 111    CALL PROCOP(OPNPTR)
  985.     IF(OPNWC.EQ.0) GOTO 115
  986.     IF(IMODE.EQ.3) OBJWC = OBJWC+2
  987.     IF(IMODE.NE.3) OBJWC = OBJWC+1
  988.     IF(IMODE.EQ.3) OBJBUF(OBJWC-1) = OPNWRD(3)
  989.     IF(IMODE.EQ.3) OBJBUF(OBJWC  ) = OPNWRD(2)
  990.     IF(IMODE.NE.3) OBJBUF(OBJWC  ) = OPNWRD(2)
  991.     IF(SRCLNE(OPNPTR).NE."54) GOTO 119
  992.     OPNPTR = OPNPTR+1
  993.     GOTO 111
  994. 115    CALL ERROR(403)
  995. 118    RFLG = IFLG
  996.     GOTO 7000
  997. 119    IF(IMODE.NE.1.OR.OPNWRD(2).GE.256) GOTO 118
  998.     OBJBUF(OBJWC)=(OBJBUF(OBJWC)*"400)
  999.     GOTO 118
  1000. C
  1001. C    DS
  1002. C
  1003. 120    PRFLG=7
  1004.     IF(OPNPTR.EQ.0) GOTO 8500
  1005.     CALL PROCOP(OPNPTR)
  1006.     IF(OPNWC.EQ.7) GOTO 134
  1007.     IF(IMODE.EQ.1) GOTO 122
  1008.     IF(IMODE.NE.3) GOTO 125
  1009.     I=JICVT(4,NEWPC)
  1010.     I=JMUL(NEWPC,OPNWRD(2),NEWPC)
  1011.     GOTO 128
  1012. 122    I=JMOV(OPNWRD(2),NEWPC)
  1013.     GOTO 128
  1014. 125    I=JICVT(2,NEWPC)
  1015.     I=JMUL(NEWPC,OPNWRD(2),NEWPC)
  1016. 128    I=JMOV(PC,OBJBUF(2))
  1017.     I=JMOV(PC,SYMVAL)
  1018.     GOTO 7005
  1019. C
  1020. C    ORG
  1021. C
  1022. 130    IF(LABEL(1).EQ.0) GOTO 132
  1023. 131    CALL ERROR(402)
  1024.     RETURN
  1025. C
  1026. 132    RFLG=1
  1027. 133    PRFLG=7
  1028.     IF(OPNPTR.NE.0) GOTO 134
  1029.     CALL I4CLR(NEWPC)
  1030.     CALL I4CLR(PC)
  1031.     RETURN
  1032. 134    CALL PROCOP(OPNPTR)
  1033.     IF(OPNWC.EQ.7) GOTO 135
  1034.     CALL I4CLR(PC)
  1035.     I=JADD(NEWPC,OPNWRD(2),NEWPC)
  1036.     RETURN
  1037. 135    CALL ERROR(403)
  1038.     RETURN
  1039. C
  1040. C    END <STARTING ADR>
  1041. C
  1042. 140    ISERR=1
  1043.     IF(LABEL(1).NE.0) GOTO 131
  1044.     PRFLG=5
  1045.     RETURN
  1046. C
  1047. C    EQU
  1048. C
  1049. 150    IF(LABEL(1).EQ.0) GOTO 131
  1050.     PRFLG=6
  1051.     IF(OPNPTR.EQ.0) GOTO 8500
  1052.     CALL PROCOP(OPNPTR)
  1053.     IF(OPNWC.EQ.7) RETURN
  1054.     CALL SYMTBL(2,OPNWRD(2),LABEL)
  1055.     IF((SYMFLG(STIND).AND."10).EQ."10)CALL ERROR(409)
  1056.     I=JMOV(OPNWRD(2),SYMADR(STIND))
  1057.     SYMFLG(STIND)=SYMFLG(STIND).OR.16
  1058.     I=JMOV(SYMADR(STIND),OBJBUF(2))
  1059.     RETURN
  1060. C
  1061. C    RORG
  1062. C
  1063. 160    IF(LABEL(1).NE.0) GOTO 131
  1064.     RFLG=0
  1065.     GOTO 133
  1066. C
  1067. C    PAGE
  1068. C
  1069. 170    IF(LABEL(1).NE.0)GOTO 131
  1070.     LFLG=0
  1071.     PRFLG=9
  1072.     RETURN
  1073. C
  1074. C    LIST
  1075. C
  1076. 180    IF(LABEL(1).NE.0)GOTO 131
  1077.     LFLG=1
  1078.     PRFLG=3
  1079.     RETURN
  1080. C
  1081. C    NLIST
  1082. C
  1083. 190    IF(LABEL(1).NE.0) GOTO 131
  1084.     LFLG=0
  1085.     PRFLG=3
  1086.     RETURN
  1087. C
  1088. C    NAM
  1089. C
  1090. 195    IF(LABEL(1).NE.0) GOTO 131
  1091.     DO 197 I=1,8
  1092. 197    NAME(I)="40
  1093.     N=1
  1094.     DO 196 I=OPNPTR,OPNPTR+7
  1095.     NAME(N)=SRCLNE(I)
  1096.     N=N+1
  1097. 196    IF(I.EQ.LNELEN-1) RETURN
  1098.     RETURN
  1099. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1100. C
  1101. C    PROCESS INHERENT INSTRUCTIONS..IE NOP
  1102. C
  1103. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1104. 200    OBJBUF(1)=OPSKEL
  1105.     GOTO 7000
  1106. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1107. C
  1108. C    PROCESS MOVE INSTRUCTION
  1109. C    <EA>,<EA>  SR,<EA>  <EA>,CCR  <EA>,SR  USP,An  An,USP
  1110. C
  1111. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1112. C
  1113. C....    LOOK FOR OBVIOUS MISTAKES
  1114. C
  1115. 300    IF(OP2EA .EQ.6.OR.OP1EA .EQ.8) GOTO 8500
  1116.     IF(OP1EA.EQ.9 .AND.OP2EA.NE.2) GOTO 8500
  1117.     IF(OP1EA.NE.2 .AND.OP2EA.EQ.9) GOTO 8500
  1118.     IF(OPNPTR.EQ.0.OR.OPNPT2.EQ.0) GOTO 8500
  1119. C
  1120. C....    SR,<EA> - USP,<EA>
  1121. C
  1122.     IF(OP1EA.EQ.7.OR. OP1EA.EQ.9) GOTO 350
  1123. C
  1124. C....    OP1EA = 1 THRU 5
  1125. C
  1126.     IF((OP1EA.GE.1).AND.(OP1EA.LE.5)) GOTO 305
  1127. C
  1128. C....    PROCESS FIRST OPN HERE IF COMPLEX
  1129. C
  1130.     CALL PROCOP(OPNPTR)
  1131. C
  1132. C....    CHECK FOR EA TYPES 7-9
  1133. C
  1134. 303    IF(OP2EA.GT.6) GOTO 340
  1135. C
  1136. C....    CHECK FOR FIRST OPERAND IMMEDIATE MODE ADDRESSING
  1137. C
  1138.     IF (OP1EA.NE.6) GOTO 304
  1139. C
  1140. C....    SKIP MOVQ IF FWD REF SYMBOL
  1141. C
  1142.     IF(OPNFLG.EQ.1) GOTO 304        ! CANNOT BE FWD REF SYM
  1143.     IF(IMODE .NE.3) GOTO 304        ! MUST BE .L MODE
  1144.     IF(OPNWRD(3).EQ. 0) GOTO 301        ! HI WORD MUST BE ZERO
  1145.     IF(OPNWRD(3).EQ.-1) GOTO 301        ! OR MINUS ONE
  1146.     GOTO 304
  1147. C
  1148. C....    CHECK IF VAL WITHIN RANGE FOR MOVEQ (+/- 128)
  1149. C....    ALSO CHECK IF DESTINATION IS A DATA REGISTER
  1150. C
  1151. 301    I=ICKVAL(OPNWRD(2))
  1152.     IF ((I.EQ.0).AND.(OP2EA.EQ.1)) GOTO 330
  1153. C
  1154. C....    ADD IN OPCODE SIZE BITS
  1155. C
  1156. 304    OBJBUF(1)=OBJBUF(1).OR."30000
  1157.     IF(IMODE.EQ.1) OBJBUF(1)=(OBJBUF(1)).AND."17777
  1158.     IF(IMODE.EQ.3) OBJBUF(1)=(OBJBUF(1)).AND."27777
  1159. C
  1160. C....    MOVE IN NUMBERS FOR 1ST AND 2ND EXT WORDS
  1161. C
  1162.     OBJWC     = OBJWC+OPNWC
  1163.     OBJBUF(2) = OPNWRD(2)
  1164.     OBJBUF(1) = OPNWRD(1)
  1165.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1166.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1167.     GOTO 310
  1168. C
  1169. C....    PROCESS EA TYPES 0-5 FOR FIRST OPN
  1170. C
  1171. 305    OBJBUF(1)=(((OP1EA-1)*"10).OR.OP1DA)
  1172. C
  1173. C....    CHK FOR SIMPLE SECOND OPERANDS
  1174. C
  1175. 310    IF(OP2EA.EQ.0) GOTO 315
  1176. C
  1177. C....    CHK FOR SR,CCR,USP
  1178. C
  1179.     IF(OP2EA.GT.6) GOTO 340
  1180.     GOTO 320
  1181. C
  1182. C....    CALCULATE COMPLEX SECOND OPN
  1183. C
  1184. 315    CALL PROCOP(OPNPT2)
  1185.     OBJBUF(OBJWC+1)=OPNWRD(2)
  1186.     IF(OPNWC.EQ.2) OBJBUF(OBJWC+2)=OPNWRD(2)
  1187.     IF(OPNWC.EQ.2) OBJBUF(OBJWC+1)=OPNWRD(3)
  1188.     OBJWC=OBJWC+OPNWC
  1189.     I=(OPNWRD(1).AND.7)*"10
  1190.     J=(OPNWRD(1).AND."70)/8
  1191.     OBJBUF(1)=OBJBUF(1).OR.((I+J)*"100).OR."30000
  1192.     GOTO 325
  1193. C
  1194. C....    PROCESS EA TYPES 0-5 FOR SECOND OPN
  1195. C
  1196. 320    OBJBUF(1)=OBJBUF(1)+(((OP2EA-1).OR.(OP2DA*"10))*"100).OR."30000
  1197. C
  1198. C....    ADD IN SIZE BITS
  1199. C
  1200. 325    IF(IMODE.EQ.1)OBJBUF(1)=OBJBUF(1).AND."17777
  1201.     IF(IMODE.EQ.3)OBJBUF(1)=OBJBUF(1).AND."27777
  1202.     GOTO 7000
  1203. C
  1204. C....    GEN MOVEQ ALSO CLR SIZE BITS IF SET
  1205. C
  1206. 330    OBJBUF(1) = 0
  1207.     OBJBUF(1) = (OPNWRD(2).AND."377).OR."70000.OR.(OP2DA*"1000)
  1208.     GOTO 7000
  1209. C
  1210. C....    GENERATE MOVE <EA>,SR - <EA>,CCR - AN,USP
  1211. C
  1212. 340    IF(OP2EA.EQ.7) OBJBUF(1)="43300
  1213.     IF(OP2EA.EQ.8) OBJBUF(1)="42300
  1214.     IF(OP2EA.NE.9) GOTO 342
  1215.     OBJBUF(1) = "47140.OR.OP1DA
  1216.     GOTO 7000
  1217. C
  1218. C....    GET NON-REG EA'S IF 0 OR 6
  1219. C
  1220. 342    IF(OP1EA.EQ.0.OR.OP1EA.EQ.6) GOTO 349
  1221. C
  1222. C....    ELSE JUST ADD OR IN THE EA AND REG
  1223. C
  1224.     OBJBUF(1)=OBJBUF(1).OR.OP1DA.OR.((OP1EA-1)*"10)
  1225.     GOTO 7000
  1226.  
  1227. C
  1228. C....    HANDLE STUFF FOR EA'S 0 AND 6
  1229. C
  1230. 349    OBJBUF(1)=OBJBUF(1).OR.OPNWRD(1)
  1231.     OBJBUF(2)=OPNWRD(2)
  1232.     IF(OPNWC.EQ.2)OBJBUF(2)=OPNWRD(3)
  1233.     IF(OPNWC.EQ.2)OBJBUF(3)=OPNWRD(2)
  1234.     OBJWC=OBJWC+OPNWC
  1235.     GOTO 7000
  1236. C
  1237. C....    GENERATE MOVE SR,<EA> - USP,AN
  1238. C
  1239. 350    IF (OP1EA.EQ.9) GOTO 355        ! SR,<EA>
  1240.     IF (OP2EA.EQ.2) GOTO 8500        ! USP,AN
  1241.     IF (OP2EA.EQ.0) GOTO 353
  1242.     OBJBUF(1) = "40300.OR.OP2DA.OR.((OP2EA-1)*"10)
  1243.     GOTO 7000
  1244. C
  1245. 353    CALL PROCOP(OPNPT2)
  1246.     OBJBUF(2)=OPNWRD(2)
  1247.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1248.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1249.     OBJWC = OBJWC + OPNWC
  1250.     OBJBUF(1) = "43000.OR.OPNWRD(1)
  1251.     GOTO 7000
  1252. C
  1253. 355    OBJBUF(1) = "47150.OR.OP2DA
  1254.     GOTO 7000
  1255. C
  1256. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1257. C
  1258. C    PROCESS CMP INSTRUCTION
  1259. C    <EA>,DN <EA>,AN #DATA,<EA> (AY)+,(AX)+
  1260. C
  1261. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1262. C
  1263. 400    IF((OP1EA.EQ.6).AND.(OP2EA.NE.2)) GOTO 460    ! CMPI INSTR
  1264.     IF((OP1EA.EQ.5).AND.(OP2EA.EQ.5)) GOTO 480    ! CMPM INSTR
  1265.     IF((OP2EA.EQ.1).OR. (OP2EA.EQ.2)) GOTO 410    ! CMP <EA>,DN OR AN
  1266.     GOTO 8500                    ! ALL ELSE ILLEGAL
  1267. C
  1268. C....    PROCESS <EA>,DN <EA>,AN
  1269. C
  1270. 410    IF(OP2EA.EQ.2.AND.IMODE.EQ.1) GOTO 8500        ! CMPA CANT HAVE .B
  1271.     IF(OP2EA.NE.2) GOTO 411
  1272.     IF(IMODE.EQ.3) OPSKEL = OPSKEL.OR."500        ! CMPA.L
  1273.     IF(IMODE.NE.3) OPSKEL = OPSKEL.OR."200        ! CMPA.W
  1274. 411    IF((OP1EA.EQ.0).OR.(OP1EA.EQ.6)) GOTO 415    ! COMPLEX OPN
  1275. C
  1276. C....    PROCESS FOR REG OPNS
  1277. C
  1278. 412    OBJBUF(1)=OPSKEL.OR.(OP2DA*"1000).OR.((OP1EA-1)*"10).OR.OP1DA
  1279.     GOTO 6000
  1280. C
  1281. C....    PROCESS FOR COMPLEX 1ST OPNS
  1282. C
  1283. 415    CALL PROCOP(OPNPTR)
  1284.     OBJBUF(1) = OPSKEL.OR.(OP2DA*"1000).OR.(OPNWRD(1).AND."77)
  1285.     OBJBUF(2)=OPNWRD(2)
  1286.     IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
  1287.     IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
  1288.     OBJWC=OBJWC+OPNWC
  1289.     GOTO 6000
  1290. C
  1291. C....    CMPI INSTRUCTION
  1292. C....    EVALUATE THE IMMEDIATE PART
  1293. C
  1294. 460    CALL PROCOP(OPNPTR)
  1295.     OBJWC = OBJWC + OPNWC
  1296.     OBJBUF(2)=OPNWRD(2)
  1297.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)        ! PLAY GAMES IF 2 WDS
  1298.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1299. C
  1300. C....    CHECK FOR SIMPLE DESTINATION EA
  1301. C
  1302.     IF((OP2EA.GT.0).AND.(OP2EA.LT.6)) GOTO 470
  1303.     IF(OP2EA.GT.6) GOTO 8500
  1304.     CALL PROCOP(OPNPT2)
  1305.     OBJBUF(1) = OPSK2.OR.(OPNWRD(1).AND."77)
  1306.     OBJBUF(OBJWC+1) = OPNWRD(2)
  1307.     IF (OPNWC.EQ.2) OBJBUF(OBJWC+1) = OPNWRD(3)
  1308.     IF (OPNWC.EQ.2) OBJBUF(OBJWC+2) = OPNWRD(2)
  1309.     OBJWC = OBJWC+OPNWC
  1310.     GOTO 6000
  1311. C
  1312. C....    SECOND EA IS NOT COMPLEX
  1313. C
  1314. 470    OBJBUF(1) = OPSK2.OR.OP2DA.OR.((OP2EA-1)*"10)
  1315.     GOTO 6000
  1316. C
  1317. C....    CMPM (AY)+,(AX)+
  1318. C
  1319. 480    OBJBUF(1)=OPSKEL+((OP2DA*"1000)+OP1DA)
  1320.     GOTO 6000
  1321. C
  1322. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1323. C
  1324. C    PROCESS ADD,SUB INSTRUCTIONS
  1325. C    <EA>,DN <EA>,AN  DN,<EA> #DATA,<EA>
  1326. C
  1327. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1328. C
  1329. 500    IF(OP2EA.EQ.2) GOTO 525        ! ADDA,SUBA
  1330.     IF(OP1EA.EQ.6) GOTO 530        ! ADDI,SUBI
  1331.     IF(OP1EA.EQ.1.OR.OP2EA.EQ.1)  GOTO 510
  1332.     GOTO 8500            ! ALL OTHERS ILLEGAL
  1333. C
  1334. C....
  1335. C
  1336. 510    IF(OP2EA.EQ.1) GOTO 520
  1337.     OPSKEL = OPSKEL .OR. "400
  1338. C
  1339. C....    GENERATE DN,<EA>
  1340. C
  1341.     OPSKEL = OPSKEL.OR.(OP1DA*"1000)
  1342.     IF(OP2EA.EQ.0) GOTO 511
  1343.     OBJBUF(1) = OPSKEL.OR.((OP2EA-1)*"10).OR.OP2DA
  1344.     GOTO 6000
  1345. C
  1346. 511    CALL PROCOP(OPNPT2)
  1347. 514    OBJBUF(2) = OPNWRD(2)
  1348.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1349.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1350.     OBJWC = OBJWC+OPNWC
  1351.     OBJBUF(1) = OPSKEL.OR.OPNWRD(1)
  1352.     GOTO 6000
  1353. C
  1354. C....    GENERATE <EA>,DN
  1355. C
  1356. 520    OPSKEL = OPSKEL.OR.(OP2DA*"1000)
  1357.     IF(OP1EA.EQ.0) GOTO 522
  1358. 521    OBJBUF(1) = OPSKEL.OR.((OP1EA-1)*"10).OR.OP1DA
  1359.     GOTO 6000
  1360. C
  1361. 522    CALL PROCOP(OPNPTR)
  1362.     GOTO 514
  1363. C
  1364. C....    GENERATE <EA>,AN
  1365. C
  1366. 525    IF (IMODE.EQ.1) GOTO 8500
  1367.     IF (IMODE.EQ.3) OPSKEL = OPSKEL .OR. "500
  1368.     IF ((IMODE.EQ.2).OR.(IMODE.EQ.0)) OPSKEL = OPSKEL.OR."200
  1369.     OPSKEL = OPSKEL .OR.(OP2DA*"1000)
  1370.     IF((OP1EA.EQ.0).OR.(OP1EA.EQ.6)) GOTO 522
  1371.     OBJBUF(1) = OPSKEL.OR.((OP1EA-1)*"10).OR.OP1DA
  1372.     GOTO 6000
  1373. C
  1374. C....    GENERATE xxxI
  1375. C
  1376. 530    IF(OP2EA.GT.6) GOTO 8500
  1377. C
  1378. C....    EVALUATE IMMEDIATE EXPRESSION
  1379. C
  1380.     CALL PROCOP(OPNPTR)
  1381. C
  1382. C....    TRY GENERATING SHORT FORM OF INSTRUCTION
  1383. C....    AFTER CHECKING TO SEE IF OPERAND WAS FWD REF
  1384. C
  1385.     IF(OPNFLG.EQ.1) GOTO 536
  1386.     IF(OPNWRD(2).GE.1.AND.OPNWRD(2).LE.8) GOTO 550
  1387. C
  1388. C....    GENERATE EXTENSION WORDS
  1389. C....    LENGTH OF OPERAND DEPENDS ON THE IMODE OF INSTRUCTION
  1390. C
  1391. 536    OBJBUF(2) = OPNWRD(2)
  1392.     IF(OPNWC.EQ.2)OBJBUF(2) = OPNWRD(3)
  1393.     IF(OPNWC.EQ.2)OBJBUF(3) = OPNWRD(2)
  1394. 537    OBJWC = OBJWC + OPNWC
  1395. C
  1396. C....    IF DEST THRU REG EVAL IT HERE
  1397. C
  1398. 538    IF(OP2EA.EQ.0) GOTO 540
  1399.     OBJBUF(1)=OPSK2.OR.((OP2EA-1)*"10).OR.OP2DA
  1400.     GOTO 6000
  1401. C
  1402. C....    EVAL NON-REG DEST
  1403. C
  1404. 540    CALL PROCOP(OPNPT2)
  1405.     OBJWC = OBJWC + OPNWC
  1406.     OBJBUF(1) = OPSK2.OR.OPNWRD(1)
  1407.     IF(OPNWC.EQ.1) OBJBUF(OBJWC  ) = OPNWRD(2)
  1408.     IF(OPNWC.EQ.2) OBJBUF(OBJWC+1) = OPNWRD(3)
  1409.     IF(OPNWC.EQ.2) OBJBUF(OBJWC  ) = OPNWRD(2)
  1410.     GOTO 6000
  1411. C
  1412. C....    GENERATE xxxQ
  1413. C
  1414. 550    IF(OPNWRD(2).EQ.8) OPNWRD(2) = 0
  1415.     IF(OPSK2.EQ."2000) OPSK2 = "50400
  1416.     IF(OPSK2.EQ."3000) OPSK2 = "50000
  1417.     OPSK2 = OPSK2.OR.(OPNWRD(2)*"1000)
  1418.     GOTO 538
  1419. C
  1420. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1421. C
  1422. C    PROCESS AND,OR INSTRUCTIONS
  1423. C    <EA>,DN  DN,<EA>  #DATA,<EA>
  1424. C
  1425. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1426. C
  1427. 600    IF(OP1EA.EQ.6) GOTO 610
  1428.     IF(OP2EA.NE.1) GOTO 620
  1429. C
  1430. C....    PROCESS <EA>,DN
  1431. C
  1432.     OPSKEL=OPSKEL+(OP2DA*"1000)
  1433.     IF(OP1EA.EQ.0) GOTO 605
  1434.     OBJBUF(1)=OPSKEL.OR.OP1DA.OR.((OP1EA-1)*"10)
  1435.     GOTO 6000
  1436. C
  1437. 605    CALL PROCOP(OPNPTR)
  1438.     OBJBUF(1)=OPSKEL.OR.OPNWRD(1)
  1439.     OBJBUF(2)=OPNWRD(2)
  1440.     IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
  1441.     IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
  1442.     OBJWC=OBJWC+OPNWC
  1443.     GOTO 6000
  1444. C
  1445. C....    PROCESS #DATA,<EA>
  1446. C
  1447. 610    OPSKEL = OPSK2
  1448.     IF(OP2EA.EQ.6) GOTO 8500
  1449.     CALL PROCOP(OPNPTR)
  1450.     OBJBUF(2)=OPNWRD(2)
  1451.     IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
  1452.     IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
  1453.     OBJWC=OBJWC+OPNWC
  1454. C
  1455. C....    NOW THAT WE HAVE IMMEDIATE DATA GET ,<EA>
  1456. C
  1457.     IF(OP2EA.EQ.0.AND.OP1EA.EQ.1) GOTO 6000
  1458.     IF(OP2EA.EQ.0) GOTO 615
  1459. C
  1460. C....    CHECK FOR #DATA,SR OR #DATA,CCR
  1461. C
  1462.     IF(OP2EA.LT.7) GOTO 612
  1463.     IF(OP2EA.GT.8) GOTO 8500
  1464.     IF((IMODE.EQ.1).AND.(OP2EA.EQ.8)) GOTO 611
  1465.     IF((IMODE.EQ.1).OR.(IMODE.EQ.3))  GOTO 8500
  1466. 611    OBJBUF(1) = OPSKEL.OR."74
  1467.     GOTO 6000
  1468. 612    OBJBUF(1) = OPSKEL.OR.((OP2EA-1)*"10).OR.OP2DA
  1469.     GOTO 6000
  1470. C
  1471. C....    EVALUATE ,<EA> FOR COMPLEX ADR
  1472. C
  1473. 615    CALL PROCOP(OPNPT2)
  1474. 630    OBJBUF(OBJWC+1)=OPNWRD(2)
  1475.     IF(OPNWC.EQ.2) OBJBUF(OBJWC+1)=OPNWRD(3)
  1476.     IF(OPNWC.EQ.2) OBJBUF(OBJWC+2)=OPNWRD(2)
  1477.     OBJWC=OBJWC+OPNWC
  1478.     OBJBUF(1)=OBJBUF(1).OR.OPSKEL
  1479.     GOTO 6000
  1480. C
  1481. C....    EVALUATE DN,<EA>
  1482. C
  1483. 620    OPSKEL=OPSKEL+(OP1DA*"1000).OR."400
  1484.     IF(OP2EA.EQ.0) GOTO 615
  1485.     OBJBUF(1) = OPSKEL.OR.OP2DA.OR.((OP2EA-1)*"10)
  1486.     GOTO 6000
  1487. C
  1488. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1489. C
  1490. C    PROCESS EOR INSTRUCTION
  1491. C    DN,<EA>  #DATA,<EA>
  1492. C
  1493. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1494. 700    IF(OP1EA.EQ.6) GOTO 610
  1495.     IF(OP1EA.NE.1) GOTO 8500
  1496.     IF(OP2EA.EQ.0) GOTO 620
  1497.     OBJBUF(1)=OPSKEL+((OP1EA-1)*"1000)+OP2DA+((OP1EA-1)*"10)
  1498.     GOTO 6000
  1499. C
  1500. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1501. C
  1502. C    PROCESS ROTATES AND SHIFTS
  1503. C    DX,DY  DATA,DY  <EA>
  1504. C
  1505. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1506. 800    IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) GOTO 810
  1507.     IF(OP1EA.EQ.6.AND.OP2EA.EQ.1) GOTO 820
  1508.     IF(OP1EA.EQ.0.AND.OP2EA.EQ.1) GOTO 820
  1509. C
  1510. C....    PROCESS  <EA>
  1511. C
  1512.     IF(OP1EA.EQ.0) GOTO 801
  1513.     IF(OP1EA.LT.3.OR.OP1EA.GT.5) GOTO 8500
  1514.     OBJBUF(1)=OPSKEL+((OP1EA-1)*"10)+OP1DA
  1515.     GOTO 7000
  1516. C
  1517. 801    CALL PROCOP(OPNPTR)
  1518.     OBJBUF(1)=OPSKEL+OPNWRD(1)
  1519.     OBJBUF(2) = OPNWRD(2)
  1520.     IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1521.     IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1522.     OBJWC = OBJWC + OPNWC
  1523.     GOTO 7000
  1524. C
  1525. 810    OBJBUF(1) = OPSKEL.OR."40.OR.(OP1DA*"1000).OR.OP2DA
  1526.     GOTO 6000
  1527. C
  1528. 820    CALL PROCOP(OPNPTR)
  1529.     IF(OPNWRD(2).LT.1.OR.OPNWRD(2).GT.8) GOTO 8500
  1530.     IF(OPNWRD(2).EQ.8) OPNWRD(2)=0
  1531.     OBJBUF(1)=OPSKEL+(OPNWRD(2)*"1000)+OP2DA
  1532.     GOTO 6000
  1533. C
  1534. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1535. C
  1536. C    PROCESS BRANCH INSTRUCTIONS
  1537. C    <LABEL>
  1538. C
  1539. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1540. 900    IF(OPNPTR.EQ.0) GOTO 8500
  1541.     IF(OP1EA .NE.0) GOTO 8500
  1542.     BRFLG = 1
  1543. C
  1544. C....    GENERATE BRANCH ADDRESS
  1545. C
  1546.     CALL PROCOP(OPNPTR)
  1547. C
  1548. C....    CHK FOR FORCED SHORT ADR MODE
  1549. C
  1550.     IF(IMODE.EQ.4) GOTO 910
  1551. C
  1552. C....    CHECK FOR FWD REF SYMBOL OR REF BEFORE DEFINITION
  1553. C
  1554.     IF(OPNFLG.EQ.1) GOTO 905
  1555. C
  1556. C....    CHECK FOR SHORT BRANCH
  1557. C
  1558.     I = ICKVAL(OPNWRD(2))
  1559.     IF((I.EQ.0).AND.(OPNWRD(2).NE."177600)) GOTO 910
  1560.     IF(IMODE.EQ.4) CALL ERROR(404)
  1561. C
  1562. C....    ELSE GENERATE TWO WORD BRANCH
  1563. C
  1564. 905    OBJBUF(1) = OPSKEL
  1565.     OBJBUF(2) = OPNWRD(2)
  1566.     OBJWC = 2
  1567.     GOTO 920
  1568. C
  1569. C....    GENERATE SHORT BRANCH
  1570. C
  1571. 910    OBJWC =1
  1572.     OPSKEL=OPSKEL+(OPNWRD(2).AND."377)
  1573.     OBJBUF(1) = OPSKEL
  1574. 920    BRFLG = 0
  1575.     GOTO 7000
  1576. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1577. C
  1578. C    PROCESS BIT MODIFICATION INSTRUCTIONS
  1579. C    DN,<EA>  #DATA,<EA>
  1580. C
  1581. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1582. 1000    IF(OP1EA.EQ.1.OR.OP1EA.EQ.6) GOTO 1010
  1583.     GOTO 8500
  1584. 1010    IF(OP1EA.EQ.6) GOTO 1020
  1585.     IF(OP2EA.EQ.0) GOTO 1015
  1586. C
  1587. C....    SIMPLE EA'S
  1588. C
  1589.     OBJBUF(1) = OPSKEL.OR.(OP1DA*"1000).OR.OP2DA
  1590.     OBJBUF(1) = OBJBUF(1) .OR. ((OP2EA-1)*"10)
  1591.     GOTO 7000
  1592. C
  1593. 1015    CALL PROCOP(OPNPT2)
  1594.     OBJBUF(2) = OPNWRD(2)
  1595.     IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1596.     IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1597.     OBJWC = OBJWC + OPNWC
  1598.     OBJBUF(1) = OPSKEL.OR.OPNWRD(1).OR.(OP1DA*"1000)
  1599.     GOTO 7000
  1600. C
  1601. 1020    CALL PROCOP(OPNPT2)
  1602.     IF(OPNWRD(3).NE.0) GOTO 8500
  1603.     OBJBUF(2)=OPNWRD(2)
  1604.     OBJWC=OBJWC+1
  1605.     OBJBUF(1)=OPSK2+(OPNWRD(1).AND."77)
  1606.     GOTO 7000
  1607. C
  1608. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1609. C
  1610. C    PROCESS MULT DIV AND CHK INSTRUCTIONS
  1611. C    <EA>,DN
  1612. C
  1613. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1614. 1100    IF(OP2EA.NE.1) GOTO 8500
  1615.     IF(OP1EA.EQ.2) GOTO 8500
  1616.     IF(OP1EA.EQ.0.OR.OP1EA.EQ.6) GOTO 1110
  1617.     IF(OP1EA.GT.6) GOTO 8500
  1618.     OPSKEL=OPSKEL+((OP1EA-1)*"10)+OP1DA
  1619.     GOTO 1120
  1620. 1110    CALL PROCOP(OPNPTR)
  1621.     OPSKEL=OPSKEL+OPNWRD(1)
  1622.     OBJBUF(2)=OPNWRD(2)
  1623.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1624.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1625.     OBJWC = OBJWC + OPNWC
  1626. 1120    OBJBUF(1)=OPSKEL+(OP2DA*"1000)
  1627.     GOTO 7000
  1628. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1629. C
  1630. C    PROCESS INSTRUCTIONS OF FORM OPCODE <EA>
  1631. C
  1632. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1633. C    CHK FOR CLR,NEG
  1634. 1200    IF(OPIDX.EQ.18.OR.OPIDX.EQ.25) GOTO 1202
  1635. C    CHK FOR NOT,TST
  1636.     IF(OPIDX.EQ.27.OR.OPIDX.EQ.48) GOTO 1202
  1637.     IF(IMODE.NE.0) GOTO 8500        ! SIZE BITS ILLEGAL
  1638.     GOTO 1210
  1639. 1202    IF(IMODE.EQ.1) GOTO 1205
  1640.     IF(IMODE.EQ.3) OPSKEL=OPSKEL+"200
  1641.     IF(IMODE.EQ.2.OR.IMODE.EQ.0)OPSKEL=OPSKEL+"100
  1642. 1205    IF(OP1EA.EQ.0.OR.OP1EA.GE.6) GOTO 1210
  1643.     IF(OP1EA.GT.6) GOTO 8500
  1644. C
  1645. C....    PROCESS REG OPERAND
  1646. C
  1647.     OBJBUF(1)=OPSKEL+OP1DA+((OP1EA-1)*"10)
  1648.     GOTO 7000
  1649. C
  1650. C....    PROCESS COMPLEX OPERAND
  1651. C
  1652. 1210    IF(OP1EA.NE.0.AND.OP1EA.NE.3) GOTO 8500
  1653.     IF(OP1EA.NE.3) GOTO 1215
  1654.     OBJBUF(1) = OPSKEL.OR.OP1DA.OR."20
  1655.     GOTO 7000
  1656. C
  1657. C....    GENERATE EXTENSION WORDS AS NECESSARY
  1658. C
  1659. 1215    CALL PROCOP(OPNPTR)
  1660.     OBJBUF(1) = OPSKEL.OR.OPNWRD(1)
  1661.     OBJBUF(2) = OPNWRD(2)
  1662.     IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1663.     IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1664.     OBJWC = OBJWC + OPNWC
  1665.     GOTO 7000
  1666. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1667. C
  1668. C    PROCESS DECR AND BRANCH INSTRUCTIONS
  1669. C    DN,<LABEL>
  1670. C
  1671. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1672. 1300    IF(OP1EA.NE.1) GOTO 8500
  1673.     OBJBUF(1)=OPSKEL+OP1DA
  1674.     I=RFLG
  1675.     RFLG=0
  1676.     SCANPT = OPNPT2
  1677.     CALL PROCOP(OPNPT2)
  1678.     OBJBUF(2)=OPNWRD(2)
  1679.     IF(I.EQ.1) RFLG=1
  1680.     OBJWC=2
  1681.     GOTO 7000
  1682. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1683. C
  1684. C    PROCESS EXG INSTRUCTION
  1685. C    RX,RY
  1686. C
  1687. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1688. 1400    IF(OP1EA.EQ.0.OR.OP1EA.GT.2) GOTO 8500
  1689.     IF(OP2EA.EQ.0.OR.OP2EA.GT.2) GOTO 8500
  1690.     OPSKEL=OPSKEL+OP2DA
  1691.     OPSKEL=OPSKEL+(OP1DA *"1000)
  1692.     IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) OBJBUF(1)=OPSKEL+"500
  1693.     IF(OP1EA.EQ.2.AND.OP2EA.EQ.2) OBJBUF(1)=OPSKEL+"510
  1694.     IF(OP1EA.EQ.OP2EA) GOTO 7000
  1695.     OBJBUF(1)=OPSKEL+"610
  1696.     GOTO 7000
  1697. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1698. C
  1699. C    PROCESS EXT AND SWAP INSTRUCTIONS
  1700. C    DN
  1701. C
  1702. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1703. 1500    IF(OPIDX.EQ.28) GOTO 1510
  1704.     IF(IMODE.EQ.3 ) OPSKEL = OPSKEL.OR."100
  1705. 1510    IF(OP1EA.NE.1) GOTO 8500
  1706.     OBJBUF(1)=OPSKEL+OP1DA
  1707.     GOTO 7000
  1708. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1709. C
  1710. C    PROCESS LEA INSTRUCTION
  1711. C    <EA>,AN
  1712. C
  1713. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1714. 1600    IF(OP1EA.EQ.0) GOTO 1610
  1715.     IF(OP1EA.EQ.3) GOTO 1620
  1716.     GOTO 8500
  1717. C
  1718. 1610    CALL PROCOP(OPNPTR)
  1719.     OBJBUF(1) = OPSKEL.OR.OPNWRD(1).OR.OP2DA
  1720.     OBJBUF(2) = OPNWRD(2)
  1721.     IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1722.     IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1723.     OBJWC = OBJWC + OPNWC
  1724.     GOTO 7000
  1725. C
  1726. 1620    OBJBUF(1) = OPSKEL.OR.OP2DA.OR.OP1DA
  1727.     OBJBUF(1) = OBJBUF(1).OR.((OP1EA-1)*"10)
  1728.     GOTO 7000
  1729. C
  1730. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1731. C
  1732. C    PROCESS LINK INSTRUCTION
  1733. C    AN,#<DISPLACEMENT>
  1734. C
  1735. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1736. 1700    IF(OP1EA.NE.2.AND.OP2EA.NE.6) GOTO 8500
  1737.     CALL PROCOP(OPNPT2)
  1738.     IF (OPNWRD(3).EQ.0) GOTO 1710
  1739.     IF (OPNWRD(3).EQ.-1)GOTO 1710
  1740.     GOTO 8500
  1741. C
  1742. 1710    OBJWC=2
  1743.     OBJBUF(1)=OPSKEL+OP1DA
  1744.     OBJBUF(2)=OPNWRD(2)
  1745.     GOTO 7000
  1746. C
  1747. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1748. C
  1749. C    PROCESS TRAP INSTRUCTION
  1750. C    #<VECTOR>
  1751. C
  1752. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1753. 1800    IF(OP1EA.NE.6) GOTO 8500
  1754.     CALL PROCOP(OPNPTR)
  1755.     IF(OPNWC.NE.1) GOTO 8500
  1756.     IF(OPNWRD(2).GT.16) GOTO 8500
  1757.     OBJBUF(1)=OPSKEL+OPNWRD(2)
  1758.     GOTO 7000
  1759. C
  1760. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1761. C
  1762. C    PROCESS ABCD,SBCD,ADDX,SUBX INSTRUCTIONS
  1763. C    DY,DX  -(AY),-(AX)
  1764. C
  1765. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1766. 1900    IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) GOTO 1910
  1767.     IF(OP1EA.NE.5.OR.OP2EA.NE.5) GOTO 8500
  1768. 1910    IF(OP1EA.EQ.5) OPSKEL=OPSKEL+8
  1769.     OPSKEL=OPSKEL+OP2DA
  1770.     OBJBUF(1)=OPSKEL+(OP1DA*"1000)
  1771.     GOTO 7000
  1772. C
  1773. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1774. C
  1775. C    PROCESS UNLK INSTRUCTION
  1776. C    AN
  1777. C
  1778. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1779. 2000    IF(OP1EA.NE.2) GOTO 8500
  1780.     OBJBUF(1)=OPSKEL+OP1DA
  1781.     GOTO 7000
  1782. C
  1783. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1784. C
  1785. C    PROCESS MOVEM,STM,LDM INSTRUCTIONS
  1786. C
  1787. D    STM <RLIST>,<ADR>  LDM <ADR>,<RLIST>
  1788. C
  1789. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1790. 2100    IF(IMODE.EQ.1) GOTO 8500
  1791.     IF(IMODE.EQ.3) OPSKEL = OPSKEL.OR."100
  1792. C
  1793. C....    TRY PICKING UP A REGISTER OPERAND
  1794. C
  1795.     OP = OPNPTR
  1796. 2110    CALL RLSTDC(OP,DLIST,ALIST)
  1797.     IF ((DLIST.EQ.0).AND.(ALIST.EQ.0)) GOTO 2150
  1798. C
  1799. C....    CHECK IF DESTINATION EA IS LEGAL FOR A STM INSTRUCTION
  1800. C....    -(AN) AND CTL ALTERABLE ADR MODES ARE LEGAL
  1801. C
  1802.     IF ((OP2EA.EQ.3).OR.(OP2EA.EQ.5)) GOTO 2112
  1803.     IF (OP2EA.EQ.0) GOTO 2112
  1804.     GOTO 8500
  1805. C
  1806. C....    REFORMAT DATA AND ADR BITMAPS FOR STM INSTRUCTION
  1807. C
  1808. 2112    IF (OP2EA.NE.5) GOTO 2116
  1809. C
  1810. C....    -(AN) REQUIRES REGISTERS TO BE BACKWARDS IN THE BITMAP
  1811. C
  1812.     DLSTI = 0
  1813.     ALSTI = 0
  1814.     DO 2113,I=0,7
  1815. 2113    IF((DLIST.AND.(2**I)).NE.0) DLSTI = (DLSTI.OR.(2**(7-I)))
  1816. C
  1817.     DO 2114,I=0,7
  1818. 2114    IF((ALIST.AND.(2**I)).NE.0) ALSTI = (ALSTI.OR.(2**(7-I)))
  1819. C
  1820.     ALIST = DLSTI
  1821.     DLIST = ALSTI
  1822. C
  1823. C....    BUILD BITMAP
  1824. C
  1825. 2116    CALL BLDMAP(DLIST,ALIST,OBJBUF(2))
  1826. C
  1827. C....    PROCESS DESTINATION OPERAND
  1828. C
  1829.     IF (OP2EA.EQ.0) GOTO 2118
  1830. C
  1831. C....    SIMPLE DESTINATION OPERAND
  1832. C
  1833.     OBJWC = 2
  1834.     OBJBUF(1) = OPSKEL.OR.OP2DA.OR.((OP2EA-1)*"10)
  1835.     GOTO 7000
  1836. C
  1837. C....    PROCESS COMPLEX DESTINATION OPERAND
  1838. C
  1839. 2118    CALL PROCOP(OPNPT2)
  1840.     OBJBUF(1) = OPSKEL .OR. OPNWRD(1)
  1841.     OBJBUF(3) = OPNWRD(2)
  1842.     IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(3)
  1843.     IF (OPNWC.EQ.2) OBJBUF(4) = OPNWRD(2)
  1844.     OBJWC = OBJWC + OPNWC
  1845.     GOTO 7000
  1846. C
  1847. C
  1848. C....    PROCESS LDM INSTRUCTION
  1849. C
  1850. C
  1851. 2150    OPSKEL = OPSKEL.OR."2000
  1852. C
  1853. C....    CHECK IF DESTINATION IS LEGAL FOR LDM INSTRUCTION
  1854. C....    (AN)+ AND CTL ADR MODES ARE LEGAL
  1855. C
  1856.     IF ((OP2EA.EQ.3).OR.(OP2EA.EQ.4)) GOTO 2152
  1857.     IF (OP2EA.EQ.0) GOTO 2152
  1858.     GOTO 8500
  1859. C
  1860. C....    PROCESS SOURCE OPERAND
  1861. C
  1862. 2152    IF(OP1EA.EQ.0) GOTO 2155
  1863.     OBJBUF(1) = OPSKEL.OR.OP1DA.OR.((OP1EA-1)*"10)
  1864.     GOTO 2160
  1865. C
  1866. 2155    CALL PROCOP(OPNPTR)
  1867.     OBJBUF(1) = OPSKEL .OR. OPNWRD(1)
  1868.     OBJBUF(2) = OPNWRD(2)
  1869.     IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
  1870.     IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
  1871.     OBJWC = OBJWC + OPNWC
  1872. C
  1873. C....    PROCESS REGISTER LIST
  1874. C
  1875. 2160    OP = OPNPT2
  1876.     CALL RLSTDC(OP,DLIST,ALIST)
  1877.     IF ((DLIST.EQ.0).AND.(ALIST.EQ.0)) GOTO 8500    ! NO REGISTER LIST!
  1878. C
  1879. C....    REFORMAT DATA AND ADR BITMAPS FOR LDM INSTRUCTION
  1880. C
  1881.     CALL BLDMAP(DLIST,ALIST,OBJBUF(OBJWC+1))
  1882.     OBJWC = OBJWC + 1
  1883.     GOTO 7000
  1884. C
  1885. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1886. C
  1887. C    HANDLE 'NORMAL' SIZE FIELD SPECIFICATIONS
  1888. C    USING INFORMATION FROM VARIABLE 'IMODE'
  1889. C
  1890. C    SIZE FIELD NORMALLY IS IN BITS 6 AND 7 OF
  1891. C    INSTRUCTION WITH THE FOLLOWING DEFINITION
  1892. C
  1893. C          00 = .B  01 = .W  10 = .L
  1894. C
  1895. C    INSTRUCTIONS WITH IMODE = 0 DEFAULT TO
  1896. C    A SIZE OF 'WORD'
  1897. C
  1898. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1899. C
  1900. 6000    IF(IMODE.EQ.1) GOTO 7000
  1901.     IF(IMODE.EQ.3) OBJBUF(1) = OBJBUF(1).OR."200
  1902.     IF((IMODE.EQ.2).OR.(IMODE.EQ.0)) OBJBUF(1)=OBJBUF(1).OR."100
  1903. C
  1904. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1905. C
  1906. C    PROCESS LABEL FIELD
  1907. C    CURRENT PC VAL IS STORED AS SYMBOL VAL
  1908. C
  1909. C ++++++++++++++++++++++++++++++++++++++++++++++++++
  1910. C
  1911. 7000    CALL I4CLR(SYMVAL)
  1912.     I=JADD(SYMVAL,PC,SYMVAL)
  1913.     OBJWC=OBJWC*2
  1914.     I=JICVT(OBJWC,NEWPC)
  1915.     OBJWC=OBJWC/2
  1916. 7005    IF(LABEL(1).EQ.0) RETURN
  1917.     CALL SYMTBL(2,SYMVAL,LABEL)
  1918.     IF((SYMFLG(STIND).AND."10).EQ."10) CALL ERROR(409)
  1919.     RETURN
  1920. C
  1921. C    ERROR DETECTED
  1922. C
  1923. 8500    PRFLG = 0
  1924. C
  1925. C    IF AN ERROR IS DETECTED, ZERO OBJ BUFFER
  1926. C
  1927.     DO 8510 I=1,OBJWC
  1928. 8510    OBJBUF(I) = 0
  1929.     IF(PASS.EQ.2) CALL ERROR(406)
  1930.     GOTO 7000
  1931.     END
  1932.     SUBROUTINE RLSTDC(OP,DLIST,ALIST)
  1933.     IMPLICIT INTEGER (A-Z)
  1934. C
  1935. C    THIS SUBROUTINE WILL ATTEMPT TO PROCESS A REGISTER
  1936. C    LIST IN THE SOURCE LINE POINTED TO BY 'OP' INTO
  1937. C    A PAIR OF WORDS WHICH CAN BE CONVERTED INTO A REGISTER
  1938. C    BITMAP FOR THE 'MOVEM' INSTRUCTION
  1939. C
  1940.     COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
  1941.     LOGICAL*1 SRCLNE(81)
  1942. C
  1943. C...    INITIALIZE DEFAULT OUTPUT VALUES
  1944. C
  1945.     DLIST = 0
  1946.     ALIST = 0
  1947. C
  1948. C...    TRY TO FIND A REGISTER TO DECODE
  1949. C
  1950. 10    CALL RDECOD(OP,REGTYP,REGNUM)
  1951.     IF (REGTYP.NE.0) GOTO 20
  1952.     IF (GRPFLG.EQ.1) GOTO 999
  1953. C
  1954. C...    A REGISTER WASN'T DETECTED, AND NONE
  1955. C...    WAS NECESSARY (REG GROUPS), SO JUST RETURN
  1956. C
  1957.     RETURN
  1958. C
  1959. C...    CHECK FOR '/'
  1960. C
  1961. 20    IF(SRCLNE(OP).NE."57) GOTO 300
  1962. C
  1963. C...    '/' DETECTED
  1964. C
  1965. 30    IF(GRPFLG.EQ.0) GOTO 200        ! NOT REGISTER GROUP
  1966.     IF(STREG.GE.REGNUM) GOTO 999        ! R7-R0 IS ILLEGAL
  1967.     IF(STREGT.NE.REGTYP) GOTO 999        ! A0-D0 IS ILLEGAL
  1968. C
  1969. C...    SET BITS IN REGISTER LIST BITMAP
  1970. C
  1971.     IF (REGTYP.EQ.2) GOTO 100
  1972.     DO 50,I=STREG,REGNUM
  1973. 50    DLIST = (DLIST.OR.(2**I))
  1974.     GOTO 150
  1975. 100    DO 120,I=STREG,REGNUM
  1976. 120    ALIST = (ALIST.OR.(2**I))
  1977. 150    STREG = 0
  1978.     REGNUM= 0
  1979.     GRPFLG= 0
  1980.     OP = OP+1
  1981.     GOTO 10
  1982. C
  1983. C...    ADD AN INDIVIDUAL REGISTER TO LIST
  1984. C
  1985. 200    IF(REGTYP.EQ.1) DLIST = DLIST.OR.(2**REGNUM)
  1986.     IF(REGTYP.EQ.2) ALIST = ALIST.OR.(2**REGNUM)
  1987.     OP = OP+1
  1988.     GOTO 10
  1989. C
  1990. C....    CHECK FOR '-' OR END OF REGISTER LIST
  1991. C
  1992. 300    IF(SRCLNE(OP).NE."55) GOTO 30
  1993. C
  1994. C....    '-' DETECTED, SET UP FOR REG GROUP
  1995. C
  1996.     STREG = REGNUM
  1997.     STREGT= REGTYP
  1998.     GRPFLG= 1
  1999.     OP = OP+1
  2000.     GOTO 10
  2001. C
  2002. C....    ERROR PROCESSING
  2003. C
  2004. 999    DLIST = 0
  2005.     ALIST = 0
  2006.     RETURN
  2007.     END
  2008.  
  2009.     SUBROUTINE RDECOD(OP,REGTYP,REGNUM)
  2010.     IMPLICIT INTEGER (A-Z)
  2011. C
  2012. C    THIS SUBROUTINE RETURNS THE REGISTER TYPE AND NUMBER
  2013. C    IF THE NEXT TWO CHARS IN A SOURCE LINE SPECIFY REGISTERS
  2014. C
  2015. C       REGTYP = 0  NEXT TWO CHRS DON'T SPECIFY A REGISTER
  2016. C                1  DATA REGISTER
  2017. C                2  ADDRESS REGISTER
  2018. C
  2019. C       REGNUM =    REGISTER NUMBER (0-7)
  2020. C
  2021. C       OP     =    OP + 2 UNLESS A REGISTER WASN'T FOUND
  2022. C
  2023. C
  2024.     COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
  2025.     LOGICAL*1 SRCLNE(81)
  2026. C
  2027.     REGTYP = 0
  2028.     IF (SRCLNE(OP).EQ."101) REGTYP = 2
  2029.     IF (SRCLNE(OP).EQ."104) REGTYP = 1
  2030.     IF (REGTYP.EQ.0) RETURN
  2031.     OP = OP+1
  2032.     IF ((SRCLNE(OP).LT."60).OR.(SRCLNE(OP).GT."67)) RETURN
  2033.     REGNUM = (SRCLNE(OP).AND."7)
  2034.     OP = OP+1
  2035.     RETURN
  2036.     END
  2037.     SUBROUTINE PROCOP(OP)
  2038. C
  2039. C    EVALUATE COMPLEX EFFECTIVE ADDRESSES
  2040. C
  2041. C
  2042. C    OUTPUT WORDS:
  2043. C
  2044. C    OPNFLG  0 IF OPERAND CAN BE USED IN 'QUICK' INSTRUCTIONS
  2045. C               1 IF OPERAND CONTAINED A FWD REF SYMBOL
  2046. C
  2047. C       OPNWC   NUMBER OF BYTES GENERATED (6 MAX)
  2048. C
  2049. C       OPNWRD  OPERAND WORDS GENERATED
  2050. C               FIRST WORD - ADR TYPE
  2051. C               NEXT  WORD - OPN DATA <LOW  WORD>
  2052. C               NEXT  WORD - OPN DATA <HIGH WORD>
  2053. C
  2054.     IMPLICIT INTEGER (A-Z)
  2055. C
  2056.     COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
  2057. C
  2058.     COMMON /OPWD  / OPNFLG,OPNWC,OPNWRD
  2059. C
  2060.     COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,BRFLG
  2061. C
  2062.     COMMON /LST   / LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
  2063. C
  2064.     COMMON /PRSE  / OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  2065.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  2066. C
  2067.     COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
  2068. C
  2069.     COMMON /SYMN  /    SYMSYM,SYMLIN
  2070.     DIMENSION OBJBUF(40),OPNWRD(3),SYMLIN(512),SYMSYM(4,512)
  2071.     LOGICAL*1 TMPSYM(8),SYMFLG(513),NAME(8),SRCLNE(81),LABEL(8)
  2072.     INTEGER*4 SYMVAL,TMPVAL,SYMADR(512),J2,J4,J10
  2073.     INTEGER*4 PC,NEWPC,J0
  2074. C
  2075. C....    INITIALIZE I*4 CONSTANTS
  2076. C
  2077.     J0  = 0
  2078.     J2  = 2
  2079.     J4  = 4
  2080.     J10 = 10
  2081.     J256 = 256
  2082. C
  2083. C....    ZERO OPERAND RESULT BUFFER
  2084. C
  2085.     DO 10,I=1,3
  2086. 10    OPNWRD(I) = 0
  2087. C
  2088. C....    SET PARSE POINTER TO START OF OPN FOR ERROR PROCESSOR
  2089. C
  2090.     SCANPT = OP
  2091. C
  2092. C....    DEFAULT IS NON-IMMEDIATE MODE
  2093. C....    WITH SUB-OPNS ADDED TO ORIG OPN
  2094. C
  2095.     IMD   = 0
  2096.     AMD   = 1
  2097.     OPNWC = 0
  2098.     OPNFLG= 0
  2099.     STIND = 0
  2100.     OPNFLG = 0
  2101.     CALL I4CLR(SYMVAL)
  2102.     CALL I4CLR(TMPVAL)
  2103. C
  2104. C....    CHECK FOR '#' <IMMEDIATE MODE>
  2105. C
  2106. 20    IF(SRCLNE(OP).NE."43) GOTO 30
  2107.     IMD=1
  2108. 25    OP=OP+1
  2109.     CALL I4CLR(TMPVAL)
  2110. C
  2111. C....    CHECK FOR ASCII LITERAL '
  2112. C
  2113. 30    IF (SRCLNE(OP).NE."47) GOTO 35
  2114.     IMD = 1
  2115.     OP = OP+1
  2116.     NOCHRS = 0
  2117.     CALL I4CLR(TMPVAL)
  2118. 31    IF (SRCLNE(OP).EQ."47) GOTO 32
  2119.     I=JMUL(J256,TMPVAL,TMPVAL)
  2120.     NVAL = SRCLNE(OP)
  2121.     I=JICVT(NVAL,JADN)
  2122.     I=JADD(TMPVAL,JADN,TMPVAL)
  2123.     OP = OP+1
  2124.     NOCHRS = NOCHRS+1
  2125.     IF (NOCHRS.LT.5) GOTO 31
  2126. 32    IF (SRCLNE(OP).EQ."47) OP = OP+1
  2127. C
  2128. C....    CHECK FOR '*' <PC>
  2129. C
  2130. 35    IF(SRCLNE(OP).NE."52) GOTO 60
  2131.     IF(AMD.NE.1) GOTO 40
  2132.     I=JADD(SYMVAL,PC,SYMVAL)
  2133.     GOTO 25
  2134. 40    IF(AMD.NE.2) GOTO 9000
  2135.     I=JSUB(SYMVAL,PC,SYMVAL)
  2136.     GOTO 25
  2137. C
  2138. C....    CHECK FOR '$' <HEXADECIMAL>
  2139. C
  2140. 60    IF(SRCLNE(OP).NE."44) GOTO 80
  2141. C
  2142. C....    HEXADECIMAL LITERAL
  2143. C
  2144. 65    OP=OP+1
  2145.     IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 70
  2146.     IF(SRCLNE(OP).GE."101.AND.SRCLNE(OP).LE."106) GOTO 75
  2147.     GOTO 200
  2148. 70    NVAL=SRCLNE(OP)-"60
  2149.     GOTO 78
  2150. 75    NVAL=SRCLNE(OP)-"67
  2151. 78    I=JLSHF(TMPVAL,J4,TMPVAL)
  2152.     I=JICVT(NVAL,JADN)
  2153.     I=JOR(TMPVAL,JADN,TMPVAL)
  2154.     GOTO 65
  2155.  
  2156. C
  2157. C....    CHECK FOR 0-9 <DECIMAL>
  2158. C
  2159. 80    IF(SRCLNE(OP).LT."60.OR.SRCLNE(OP).GT."71) GOTO 100
  2160. C
  2161. C....    DECIMAL LITERAL
  2162. C
  2163. 85    NVAL=(SRCLNE(OP)-"60)
  2164.     I=JMUL(J10,TMPVAL,TMPVAL)
  2165.     I=JICVT(NVAL,JADN)
  2166.     I=JADD(TMPVAL,JADN,TMPVAL)
  2167.     OP=OP+1
  2168.     IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 85
  2169.     GOTO 200
  2170.  
  2171. C
  2172. C....    CHECK FOR A-Z <SYMBOLIC>
  2173. C
  2174. 100    IF(SRCLNE(OP).LT."101.OR.SRCLNE(OP).GT."132) GOTO 200
  2175.     N=1
  2176.     DO 110 OP=OP,OP+7
  2177.     IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 105
  2178.     IF(SRCLNE(OP).LT."101.OR.SRCLNE(OP).GT."132) GOTO 120
  2179. 105    TMPSYM(N)=SRCLNE(OP)
  2180. 110    N=N+1
  2181. 115    IF(SRCLNE(OP).LT."60) GOTO 120
  2182.     IF(SRCLNE(OP).GT."71.AND.SRCLNE(OP).LT."101) GOTO 120
  2183.     IF(SRCLNE(OP).GT."132) GOTO 120
  2184.     OP=OP+1
  2185.     GOTO 115
  2186. C
  2187. C....    FILL EXTRA CHRS WITH SPACES
  2188. C
  2189. 120    IF(N.GT.8) GOTO 125
  2190.     TMPSYM(N) = "40
  2191.     N=N+1
  2192.     GOTO 120
  2193.  
  2194. C
  2195. C....    SEARCH SYMBOL TBL
  2196. C
  2197. 125    I=1
  2198.     CALL SYMTBL(I,0,TMPSYM)
  2199. C
  2200. C....    IF SYMLIN LESS THAN CURRENT LINE AND NOT 0
  2201. C....    THEN SYMBOL IS DEFINED AND IS NOT A FWD REF
  2202. C
  2203.     IF((SYMLIN(STIND).LT.NOCARD).AND.(SYMLIN(STIND).NE.0)) GOTO 130
  2204. C
  2205. C....    CHECK FOR UNDEFINED SYMBOL
  2206. C
  2207.     IF(SYMLIN(STIND).EQ.0     ) GOTO 150    ! SYMBOL UNDEFINED
  2208. C
  2209. C....    WE GET TO HERE IF THE SYMBOL IS DEFINED
  2210. C....    BUT WASNT AS OF THIS LINE IN THE ASSEMBLY DURING PASS ONE
  2211. C
  2212.     OPNFLG = 1                ! SYMBOL WAS FWD REF
  2213. C
  2214. C....    LABEL HAS BEEN DEFINED
  2215. C....    GET VALUE OF LABEL AND PUT IN TMPVAL
  2216. C
  2217. 130    CALL I4CLR(TMPVAL)
  2218.     I=JADD(TMPVAL,SYMADR(STIND),TMPVAL)
  2219.     GOTO 200
  2220. C
  2221. C....    GO HERE ON UNDEFINED FIRST AND SECOND PASS SYMBOLS
  2222. C
  2223. 150    IF (PASS.EQ.2) CALL ERROR(407)        ! UNDEFINED SYMBOL !!
  2224. C
  2225. C    IF THIS IS THE FIRST PASS, THEN THE LENGTH
  2226. C    OF ALL OPERANDS OTHER THAN IMMEDIATE BYTE AND WORD
  2227. C    ARE FORCED TO TWO WORDS
  2228. C
  2229.     OPNFLG = 1
  2230.     IF((IMD.EQ.1).AND.(IMODE.NE.3)) GOTO 160
  2231.     OPNWC = 2
  2232.     RETURN
  2233. 160    OPNWC = 1
  2234.     RETURN
  2235. C
  2236. C....    PROCESS +,-,*,/,&,!,<<,>>
  2237. C
  2238. 200    IF(AMD.EQ.1)  I=JADD(SYMVAL,TMPVAL,SYMVAL)
  2239.     IF(AMD.EQ.2)  I=JSUB(SYMVAL,TMPVAL,SYMVAL)
  2240.     IF(AMD.EQ.3)  I=JMUL(SYMVAL,TMPVAL,SYMVAL)
  2241.     IF(AMD.EQ.4)  GOTO 205
  2242.     IF(AMD.EQ.5)  I=JAND(SYMVAL,TMPVAL,SYMVAL)
  2243.     IF(AMD.EQ.6)  I=JOR (SYMVAL,TMPVAL,SYMVAL)
  2244.     IF(AMD.EQ.7)  I=JLSHF(SYMVAL,TMPVAL,SYMVAL)
  2245.     IF(AMD.EQ.8)  I=JRSHF(SYMVAL,TMPVAL,SYMVAL)
  2246.     GOTO 210
  2247. C
  2248. C....    DIVIDING BY ZERO IS BAD NEWS
  2249. C
  2250. 205    IF(TMPVAL.EQ.0) GOTO 9000
  2251.     I=JDIV(SYMVAL,TMPVAL,SYMVAL)
  2252. 210    AMD=1
  2253. C
  2254. C....    CHECK FOR +,-,*,/
  2255. C
  2256.     IF(SRCLNE(OP).NE."53) GOTO 220
  2257.     AMD=1
  2258.     GOTO 25
  2259. C
  2260. 220    IF(SRCLNE(OP).NE."55) GOTO 230
  2261.     AMD=2
  2262.     GOTO 25
  2263. C
  2264. 230    IF(SRCLNE(OP).NE."52) GOTO 240
  2265.     AMD=3
  2266.     GOTO 25
  2267. C
  2268. 240    IF(SRCLNE(OP).NE."57) GOTO 245
  2269.     AMD=4
  2270.     GOTO 25
  2271. C
  2272. 245    IF(SRCLNE(OP).NE."46) GOTO 246
  2273.     AMD = 5
  2274.     GOTO 25
  2275. C
  2276. 246    IF(SRCLNE(OP).NE."41) GOTO 247
  2277.     AMD = 6
  2278.     GOTO 25
  2279. C
  2280. 247    IF(SRCLNE(OP).NE."74) GOTO 248
  2281.     IF(SRCLNE(OP+1).NE."74) GOTO 9000
  2282.     OP = OP+1
  2283.     AMD = 7
  2284.     GOTO 25
  2285. C
  2286. 248    IF(SRCLNE(OP).NE."76) GOTO 249
  2287.     IF(SRCLNE(OP+1).NE."76) GOTO 9000
  2288.     OP = OP+1
  2289.     AMD = 8
  2290.     GOTO 25
  2291. C
  2292. 249    IF(SRCLNE(OP).NE."50) GOTO 300
  2293.     IF(IMD.EQ.1) GOTO 9000
  2294.     IF(SRCLNE(OP+3).NE."51) GOTO 250
  2295. C
  2296. C....    A(An)
  2297. C
  2298.     IF(SRCLNE(OP+1).NE."101) GOTO 9000
  2299.     IF(SRCLNE(OP+2).LT."60.OR.SRCLNE(OP+2).GT."67) GOTO 9000
  2300.     OPNWC=1
  2301.     OPNWRD(1)=(SRCLNE(OP+2)-"60)+"50
  2302.     CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
  2303.     RETURN
  2304. C
  2305. C....    A(An,Rn.m)
  2306. C
  2307. 250    CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
  2308.     I = ICKVAL(OPNWRD(2))
  2309.     IF (I.EQ.0) GOTO 252
  2310.     CALL ERROR(408)
  2311.     RETURN
  2312. C
  2313. C....    INDEX OK..DO THE REST
  2314. C
  2315. 252    OPNWC=1
  2316.     IF(SRCLNE(OP+1).NE."101)GOTO 9000
  2317.     IF(SRCLNE(OP+2).LT."60.OR.SRCLNE(OP+2).GT."67) GOTO 9000
  2318.     OPNWRD(1)=(SRCLNE(OP+2)-"60)+"60
  2319. C
  2320. C....    CHECK FOR DATA OR ADR REG
  2321. C
  2322.     IF(SRCLNE(OP+4).EQ."101.OR.SRCLNE(OP+4).EQ."104) GOTO 255
  2323.     GOTO 9000
  2324. 255    IF(SRCLNE(OP+4).EQ."101) OPNWRD(2)=OPNWRD(2)+"100000
  2325.     IF(SRCLNE(OP+5).LT."60.OR.SRCLNE(OP+5).GT."67) GOTO 9000
  2326.     OPNWRD(2)=OPNWRD(2)+((SRCLNE(OP+5)-"60)*"10000)
  2327.     IF(SRCLNE(OP+7).EQ."114) OPNWRD(2)=OPNWRD(2)+"4000
  2328.     RETURN
  2329. C
  2330. C....    CHECK FOR END OF OPERAND
  2331. C
  2332. 300    IF(SRCLNE(OP).EQ.0.OR.SRCLNE(OP).EQ."40) GOTO 350
  2333.     IF(SRCLNE(OP).NE."54) GOTO 25
  2334. C
  2335. C....    IF BRANCH INSTRUCTION PROC VAL AS PC REL OFFSET
  2336. C
  2337. 350    IF(BRFLG.EQ.1) GOTO 355
  2338. C
  2339. C....    PROCESS VAL AS PC REL UNLESS ITS ABS OR IMMEDIATE
  2340. C
  2341.     IF(RFLG.NE.0.OR.IMD.EQ.1) GOTO 400
  2342. C
  2343. C....    IF OPERAND CONTAINED AN EQUATED SYMBOL PROC VAL AS IMMEDIATE
  2344. C
  2345.     IF((SYMFLG(STIND).AND."20).EQ."20) GOTO 400
  2346. C
  2347. C....    GENERATE PC RELATIVE OFFSET
  2348. C
  2349. 355    OPNWRD(1)="72
  2350.     I=JSUB(SYMVAL,J2,SYMVAL)
  2351.     I=JSUB(SYMVAL,PC,OPNWRD(2))
  2352.     OPNWC=1
  2353.     RETURN
  2354. C
  2355. C....    PROCESS IMMEDIATE DATA
  2356. C
  2357. 400    CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
  2358.     IF(IMD.NE.1) GOTO 450
  2359. 405    OPNWC = 1
  2360.     IF(IMODE.EQ.3) OPNWC=2
  2361.     OPNWRD(1)="74
  2362.     RETURN
  2363. C
  2364. 410    OPNWC=2
  2365.     OPNWRD(1)="74
  2366.     RETURN
  2367. C
  2368. C....    PROCESS ABSOLUTE ADR
  2369. C....    GENERATE LONG ADR FORM IF INSTR MODE LONG
  2370. C
  2371. 450    IF(OPNFLG.EQ.1) GOTO 460
  2372.     IF(OPNWRD(3).NE.0) GOTO 460
  2373.     IF(OPNWRD(3).LT.0) GOTO 460
  2374.     OPNWC=1
  2375.     OPNWRD(1)="70
  2376.     RETURN
  2377. C
  2378. 460    OPNWC=2
  2379.     OPNWRD(1)="71
  2380.     RETURN
  2381.  
  2382. C
  2383. C....    FATAL ERROR DETECTED
  2384. C
  2385. 9000    OPNWC=7
  2386. C
  2387. C....    MARK POSITION WHERE ERROR OCCURED
  2388. C
  2389.     SCANPT = OP
  2390.     RETURN
  2391.     END
  2392.  
  2393.     SUBROUTINE DBLSGL(IN,OUT1,OUT2)
  2394. C
  2395. C    CONVERT INTEGER*4 TO TWO INTEGER*2 NUMBERS
  2396. C
  2397.     IMPLICIT INTEGER (A-Z)
  2398.     DIMENSION IN(2)
  2399.     OUT1=IN(1)
  2400.     OUT2=IN(2)
  2401.     RETURN
  2402.     END
  2403.  
  2404.     SUBROUTINE EATYP(TYP,REG)
  2405. C
  2406. C    DETERMINE GENERAL TYPE OF OPERAND
  2407. C IN:
  2408. C    TYP    = POINTER TO START OF OPERAND
  2409. C
  2410. C OUT:
  2411. C TYP    0    = NOT REGISTER OR IMMEDIATE EA
  2412. C    1    = Dn
  2413. C    2    = An
  2414. C    3    = (An)
  2415. C    4    = (An)+
  2416. C    5    =-(An)
  2417. C    6    =#DATA
  2418. C    7    = SR
  2419. C    8    = CCR
  2420. C    9    = USP
  2421. C    10    = ERROR DETECTED
  2422. C
  2423. C REG    REG#    0-7
  2424. C
  2425.     IMPLICIT INTEGER (A-Z)
  2426.     COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  2427.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  2428.     COMMON/SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  2429.     BYTE SRCLNE(81),LABEL(8)
  2430.     OP=TYP
  2431. 100    TYP=0
  2432.     IF(SRCLNE(OP).EQ."43)GOTO 700
  2433.     IF(SRCLNE(OP).EQ."50)GOTO 500
  2434.     IF(SRCLNE(OP).EQ."55.AND.SRCLNE(OP+1).EQ."50)GOTO 400
  2435.     IF(SRCLNE(OP).EQ."104.OR.SRCLNE(OP).EQ."101) GOTO 300
  2436. 210    IF(SRCLNE(OP).EQ."123.AND.SRCLNE(OP+1).EQ."122)GOTO 800
  2437. 220    IF(SRCLNE(OP).EQ."103.AND.SRCLNE(OP+1).EQ."103)GOTO 900
  2438.     IF(SRCLNE(OP).EQ."125.AND.SRCLNE(OP+1).EQ."123)GOTO 1000
  2439. 240    RETURN
  2440. 300    IF(SRCLNE(OP+1).LT."60.AND.SRCLNE(OP+1).GT."67) RETURN
  2441.     IF(SRCLNE(OP).EQ."101)GOTO 310
  2442.     TYP=1
  2443.     REG=(SRCLNE(OP+1)-"60)
  2444.     GOTO 1085
  2445. 310    TYP=2
  2446.     REG=(SRCLNE(OP+1)-"60)
  2447.     GOTO 1085
  2448. 400    IF(SRCLNE(OP+2).EQ."101.AND.(SRCLNE(OP+3).GE."60.AND.
  2449.      +SRCLNE(OP+3).LE."67).AND.SRCLNE(OP+4).EQ."51)GOTO 410
  2450.     RETURN
  2451. 410    TYP=5
  2452.     REG=(SRCLNE(OP+3)-"60)
  2453.     GOTO 1070
  2454. 500    IF(SRCLNE(OP+1).EQ."101.AND.(SRCLNE(OP+2).GE."60.AND.
  2455.      +SRCLNE(OP+2).LE."67).AND.SRCLNE(OP+3).EQ."51)GOTO 510
  2456.     RETURN
  2457. 510    IF(SRCLNE(OP+4).EQ."53)GOTO 530
  2458.     TYP=3
  2459.     REG=(SRCLNE(OP+2)-"60)
  2460.     GOTO 1075
  2461. 530    TYP=4
  2462.     REG=(SRCLNE(OP+2)-"60)
  2463.     GOTO 1070
  2464. 700    TYP=6
  2465.     RETURN
  2466. 800    TYP=7
  2467.     GOTO 1085
  2468. 900    IF(SRCLNE(OP+2).NE."122)GOTO 240
  2469.     TYP=8
  2470.     GOTO 1080
  2471. 1000    IF(SRCLNE(OP+2).NE."120)GOTO 240
  2472.     TYP=9
  2473.     GOTO 1080
  2474. 1070    IO=SRCLNE(OP+5)
  2475.     GOTO 1090
  2476. 1075    IO=SRCLNE(OP+4)
  2477.     GOTO 1090
  2478. 1080    IO=SRCLNE(OP+3)
  2479.     GOTO 1090
  2480. 1085    IO=SRCLNE(OP+2)
  2481. 1090    IF(IO.EQ.0.OR.IO.EQ."40.OR.IO.EQ."54) RETURN
  2482.     IF(TYP.LE.5.AND.TYP.GE.3) GOTO 1110
  2483. 1100    TYP=0
  2484.     RETURN
  2485. 1110    TYP=10
  2486.     RETURN
  2487.     END
  2488.  
  2489.     SUBROUTINE DECOPC
  2490. C
  2491. C    LOOKUP OPCODE
  2492. C
  2493. C    INPUT:OPCODE STARTS AT SRCLNE(OPPTR)
  2494. C
  2495.     IMPLICIT INTEGER (A-Z)
  2496. C
  2497.     BYTE LABEL(8),SRCLNE(81),PSUOP3(15),PSUOP4(12)
  2498.     BYTE PSUOP5(5),OP4BIG(28),OP4PTY(7),OP3BIG(33)
  2499.     BYTE OP3PTY(11),OP3NAM(144),OP3TYP(48),OP4NAM(120)
  2500.     BYTE OP4TYP(30),OP5NAM(15)
  2501.     DIMENSION OP4OPC(14),OP3OPC(22),OP2OPS(3),OP3OPS(48)
  2502.     DIMENSION OP4OPS(30),OP5OPS(3)
  2503.  
  2504. C
  2505.     COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  2506.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  2507. C
  2508.     COMMON/SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  2509. C
  2510.     COMMON/OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
  2511. C
  2512.     DATA PSUOP3/'O','R','G','E','N','D'
  2513.      +,'E','Q','U','N','A','M','S','E','T'/
  2514. C
  2515.     DATA PSUOP4/'R','O','R','G','P','A','G','E'
  2516.      +,'L','I','S','T'/
  2517. C
  2518.     DATA PSUOP5/'N','L','I','S','T'/
  2519. C
  2520.     DATA OP4BIG/'M','O','V','E','B','C','H','G','B','C','L','R',
  2521.      +'B','S','E','T','B','T','S','T','R','O','X','L','R','O','X','R'/
  2522. C
  2523.     DATA OP4OPC/0,0,"1100,"4100,"700,"4300,"600,"4200
  2524.      +,"400,"4000,"160420,"162700,"160020,"162300/
  2525. C
  2526.     DATA OP4PTY/3,10,10,10,10,8,8/
  2527. C
  2528.     DATA OP3BIG/'A','D','D','A','S','L','A','S','R','S','U','B'
  2529.      +,'A','N','D','C','M','P','E','O','R','L','S','L','L','S','R'
  2530.      +,'R','O','L','R','O','R'/
  2531. C
  2532.     DATA OP3OPC/"150000,"3000,"160400,"160700
  2533.      +,"160000,"160300,"110000,"2000
  2534.      +,"140000,"1000,"130000,"6000,"130400,"5000
  2535.      +,"160410,"161700,"160010,"161300
  2536.      +,"160430,"163700,"160030,"163300/
  2537. C
  2538.     DATA OP3PTY/4,8,8,4,6,5,7,8,8,8,8/
  2539. C
  2540.     DATA OP2OPS/"100000,"50700,"50300/
  2541. C
  2542.     DATA OP3NAM/
  2543.      +'B','E','Q', 'B','N','E', 'B','P','L', 'B','M','I', 'B','G','T',
  2544.      +'B','L','T', 'B','G','E', 'B','L','E', 'B','H','I', 'B','L','S',
  2545.      +'B','C','S', 'B','C','C', 'B','V','S', 'B','V','C', 'B','R','A',
  2546.      +'B','S','R', 'C','H','K', 'C','L','R', 'E','X','G', 'E','X','T',
  2547.      +'J','M','P', 'J','S','R', 'L','D','M', 'L','E','A', 'N','E','G',
  2548.      +'N','O','P', 'N','O','T', 'P','E','A', 'R','T','E', 'R','T','R',
  2549.      +'R','T','S', 'S','E','Q', 'S','N','E', 'S','P','L', 'S','M','I',
  2550.      +'S','G','T', 'S','L','T', 'S','G','E', 'S','L','E', 'S','H','I',
  2551.      +'S','L','S', 'S','C','S', 'S','C','C', 'S','T','M', 'S','V','S',
  2552.      +'S','V','C', 'T','A','S', 'T','S','T'/
  2553. C
  2554.     DATA OP3OPS/"63400,"63000,"65000,"65400,"67000,"66400,
  2555.      +"66000,"67400,"61000,"61400,"62400,"62000,"64400,"64000,
  2556.      +"60000,"60400,"40600,"41000,"140000,
  2557.      +"44200,"47300,"47200,"46200,"40700,"42000,"47161,"43000,
  2558.      +"44100,"47163,"47167,"47165,"53700,"53300,"55300,"55700,
  2559.      +"57300,"56700,"56300,"57700,"51300,"51700,"52700,"52300,
  2560.      +"44200,"54700,"54300,"45300,"45000/
  2561. C
  2562.     DATA OP3TYP/9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,11,12
  2563.      +,14,15,12,12,21,16,12,2,12,12,2,2,2,12,12,12,12,12,12
  2564.      +,12,12,12,12,12,12,21,12,12,12,12/
  2565. C
  2566.     DATA OP4NAM/'A','B','C','D','A','D','D','X','D','B','R','A', 
  2567.      +'D','B','H','I','D','B','L','S','D','B','C','C','D','B','C','S',
  2568.      +'D','B','N','E','D','B','E','Q','D','B','V','C','D','B','V','S',
  2569.      +'D','B','P','L','D','B','M','I','D','B','G','E','D','B','L','T',
  2570.      +'D','B','G','T','D','B','L','E','D','I','V','S','D','I','V','U',
  2571.      +'L','I','N','K','M','U','L','S','M','U','L','U','N','B','C','D',
  2572.      +'N','E','G','X','S','B','C','D','S','T','O','P','S','U','B','X',
  2573.      +'S','W','A','P','T','R','A','P','U','N','L','K'/
  2574. C
  2575.     DATA OP4OPS/"140400,"150400,"50710,"51310,"51710,"52310
  2576.      +,"52710,"53310,"53710,"54310,"54710,"55310,"55710,"56310
  2577.      +,"56710,"57310,"57710,"100700,"100300,"47120,"140700
  2578.      +,"140300,"44000,"40000,"100400,"47162,"110400
  2579.      +,"44100,"47100,"47130/
  2580. C
  2581.     DATA OP4TYP/19,19,13,13,13,13,13,13,13,13,
  2582.      +13,13,13,13,13,13,13,11,11,17,11,11,12,12,19,2,19
  2583.      +,15,18,20/
  2584. C
  2585.     DATA OP5NAM/'M','O','V','E','M','R','E','S','E','T',
  2586.      +'T','R','A','P','V'/
  2587. C
  2588.     DATA OP5OPS/"44200,"47160,"47166/
  2589. C
  2590. C     START OF OPCODE PROCESSING
  2591. C
  2592.     OPTYP=0
  2593.     OPSKEL=0
  2594.     SCANPT = OPPTR
  2595.     IF(OPCLEN.LE.1.OR.OPCLEN.GT.5) RETURN
  2596. C
  2597. C....    PROCESS OPCODE BY SIZE
  2598. C
  2599.     GOTO (1000,2000,3000,4000),OPCLEN-1
  2600. C
  2601. C....    TWO CHR OPCODES
  2602. C
  2603. 1000    IF(SRCLNE(OPPTR).EQ."104.OR.SRCLNE(OPPTR).EQ."117)GOTO 1010
  2604.     RETURN
  2605. 1010    IF(SRCLNE(OPPTR).EQ."117.AND.SRCLNE(OPPTR+1).EQ."122)GOTO 1020
  2606.     IF(SRCLNE(OPPTR+1).EQ."103)GOTO 1030
  2607.     IF(SRCLNE(OPPTR+1).EQ."123)GOTO 1040
  2608.     RETURN
  2609. 1020    OPTYP=6
  2610.     OPIDX=0
  2611.     OPSKEL="100000
  2612.     OPSK2=0
  2613.     RETURN    
  2614. 1030    OPTYP=1
  2615.     OPIDX=1
  2616.     OPSKEL=0
  2617.     OPSK2=0
  2618.     RETURN
  2619. 1040    OPTYP=1
  2620.     OPIDX=2
  2621.     OPSKEL=0
  2622.     OPSK2=0
  2623.     RETURN
  2624. C
  2625. C....    THREE CHR OPCODES
  2626. C
  2627. 2000    CALL OPLOOK(5,3,PSUOP3,OP3TYP,0)
  2628.     IF(OPTYP.NE.1) GOTO 2010
  2629.     OPIDX=OPIDX+2
  2630.     OPSKEL=0
  2631.     OPSK2=0
  2632.     RETURN
  2633. 2010    CALL OPLOOK(11,3,OP3BIG,OP3PTY,1)
  2634.     IF(OPTYP.EQ.0) GOTO 2020
  2635.     OPSKEL=OP3OPC((OPIDX*2)-1)
  2636.     OPSK2=OP3OPC(OPIDX*2)
  2637.     RETURN
  2638. 2020    CALL OPLOOK(48,3,OP3NAM,OP3TYP,1)
  2639.     OPSKEL=OP3OPS(OPIDX)
  2640.     OPSK2=0
  2641.     RETURN
  2642. C
  2643. C....    FOUR CHAR OPCODES
  2644. C
  2645. 3000    CALL OPLOOK(3,4,PSUOP4,OP3NAM,0)
  2646.     IF(OPTYP.NE.1) GOTO 3010
  2647.     OPIDX=OPIDX+7
  2648.     OPSKEL=0
  2649.     OPSK2=0
  2650.     RETURN
  2651. 3010    CALL OPLOOK(7,4,OP4BIG,OP4PTY,1)
  2652.     IF(OPTYP.EQ.O) GOTO 3020
  2653.     OPSKEL=OP4OPC((OPIDX*2)-1)
  2654.     OPSK2=OP4OPC(OPIDX*2)
  2655.     RETURN
  2656. 3020    CALL OPLOOK(30,4,OP4NAM,OP4TYP,1)
  2657.     IF(OPTYP.EQ.0)  RETURN
  2658.     OPSKEL=OP4OPS(OPIDX)
  2659.     OPSK2=0
  2660.     RETURN
  2661. C
  2662. C....    FIVE CHAR OPCODES
  2663. C
  2664. 4000    CALL OPLOOK(1,5,PSUOP5,OP3TYP,0)
  2665.     IF(OPTYP.NE.1) GOTO 4010
  2666.     OPIDX=11
  2667.     OPSKEL=0
  2668.     OPSK2=0
  2669.     RETURN
  2670. 4010    CALL OPLOOK(3,5,OP5NAM,OP5OPS,1)
  2671.     IF(OPTYP.EQ.0) RETURN
  2672.     IF(OPIDX.NE.1) GOTO 4012
  2673.     OPTYP=21
  2674.     GOTO 4014
  2675. 4012    OPTYP=2
  2676. 4014    OPSKEL=OP5OPS(OPIDX)
  2677.     OPSK2=0
  2678.     RETURN
  2679.     END
  2680.  
  2681.     SUBROUTINE OPLOOK(ISIZ,ISTEP,ITBL,ITYP,IPSF)
  2682. C
  2683. C....    LOOK UP OPCODE IN TABLES
  2684. C
  2685.     IMPLICIT INTEGER (A-Z)
  2686. C
  2687.     BYTE LABEL(8)
  2688. C
  2689.     COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  2690.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  2691. C
  2692.     COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
  2693. C
  2694.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  2695. C
  2696.     BYTE SRCLNE(81),ITBL(1),ITYP(1)
  2697. C
  2698.     IDX=ISIZ * ISTEP
  2699.     K=1
  2700.     I=1
  2701. 5    DO 20 IS=1,ISTEP
  2702.     IF(SRCLNE(OPPTR+(IS-1)).NE.ITBL(I+(IS-1))) GOTO 10
  2703. 20    CONTINUE
  2704.     OPIDX=K
  2705.     IF(IPSF.EQ.0) GOTO 30
  2706.     OPTYP=ITYP(K)
  2707.     RETURN
  2708. 10    I=I+ISTEP
  2709.     K=K+1
  2710.     IF(I.GE.IDX) RETURN
  2711.     GOTO 5
  2712. 30    OPTYP=1
  2713.     RETURN
  2714.     END
  2715.  
  2716.     SUBROUTINE PARSE
  2717. C
  2718. C    PARSE INCOMING SOURCE LINE
  2719. C
  2720. C IN:
  2721. C    SRCLNE    = LINE TO BE PARSED
  2722. C    LNELEN    = LENGTH OF SOURCE LINE
  2723. C OUT:
  2724. C    LABEL    = LABEL FIELD (LABEL(0)=0 IF NO LABEL)
  2725. C    OPPTR    = POINTER TO OPCODE FIELD
  2726. C    OPCLEN    = LENGTH  OF OPCODE FIELD NOT INCLUDING MODE
  2727. C    MODPTR    = POINTER TO MODE FIELD
  2728. C    IMODE    = 0 NO MODE FIELD
  2729. C        = 1 .B
  2730. C        = 2 .W
  2731. C        = 3 .L
  2732. C        = 4 .S
  2733. C    OPNPTR    = POINTER TO FIRST OPERAND
  2734. C    OPNPT2    = POINTER TO SECND OPERAND
  2735. C    CMTPTR    = POINTER TO COMMENT FIELD
  2736. C    PRFLG    = PARSE FLAG - ZERO IF ERROR DETECTED
  2737. C
  2738.     IMPLICIT INTEGER (A-Z)
  2739.     COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
  2740.     COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
  2741.      +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
  2742.     BYTE SRCLNE(81),IC,LABEL(8),MODTBL(4)
  2743.     DATA MODTBL/"102,"127,"114,"123/
  2744.     IPF   = 0
  2745.     IMODE = 0
  2746.     PRFLG = 1
  2747.     LABEL(1)=0
  2748. C
  2749. C    INITALIZE LABEL ARRAY TO ALL SPACES
  2750. C
  2751.     DO 10 I=2,8
  2752.     LABEL(I)=32
  2753. 10    CONTINUE
  2754.  
  2755.     SCANPT = 1
  2756.     OPCLEN = 0
  2757.     OPPTR = 0
  2758.     OPNPTR = 0
  2759.     OPNPT2 = 0
  2760.     MODPTR = 0
  2761.     CMTPTR = 0
  2762. C
  2763. C    IF NULL LINE IGNORE IT
  2764. C
  2765.     IF(LNELEN.NE.1) GOTO 15
  2766. 12    PRFLG=0
  2767.     RETURN
  2768. C
  2769. C    CHECK FOR A LINE OF COMMENTS
  2770. C
  2771. 15    IF(SRCLNE(1).NE."52) GOTO 16
  2772.     CMTPTR=1
  2773.     RETURN
  2774. C
  2775. C    SEE IF LABEL PRESENT
  2776. C
  2777. 16    IF(SRCLNE(SCANPT).EQ."40) GOTO 60
  2778. C
  2779. C    LABELS HAVE TO START WITH A-Z
  2780. C
  2781.     IF(SRCLNE(1).GE."101.AND.SRCLNE(1).LE.90) GOTO 30
  2782. 20    CALL ERROR(202)
  2783.     RETURN
  2784. C
  2785. 30    DO 40 SCANPT=1,8
  2786.     IF (SRCLNE(SCANPT).GE.48.AND.SRCLNE(SCANPT).LE.57) GOTO 35
  2787.     IF(SRCLNE(SCANPT).LT.65.OR.SRCLNE(SCANPT).GT.90) GOTO 45
  2788. 35    LABEL(SCANPT)=SRCLNE(SCANPT)
  2789. 40    CONTINUE
  2790. 45    IF(SCANPT.GE.4) GOTO 50
  2791.     IF(LABEL(1).EQ."101.OR.LABEL(1).EQ."104) GOTO 46
  2792.     IF(LABEL(1).EQ."123) GOTO 47
  2793.     IF(LABEL(1).EQ."103) GOTO 48
  2794.     IF(LABEL(1).NE."125) GOTO 50
  2795.     IF(LABEL(2).EQ."123.AND.LABEL(3).EQ."120) GOTO 49
  2796.     GOTO 50
  2797. C
  2798. 46    IF(SCANPT.GT.3) GOTO 50
  2799.     IF(LABEL(2).GE."60.AND.LABEL(2).LE."67) GOTO 49
  2800.     GOTO 50
  2801. C
  2802. 47    IF(LABEL(2).EQ."120.OR.LABEL(2).EQ."122) GOTO 49
  2803.     GOTO 50
  2804. C
  2805. 48    IF(LABEL(2).EQ."103.AND.LABEL(3).EQ."122) GOTO 49
  2806.     GOTO 50
  2807. C
  2808. 49    PRFLG=0
  2809.     CALL ERROR(204)
  2810.     RETURN
  2811. C
  2812. 50    IF(SRCLNE(SCANPT).EQ."40.OR.SRCLNE(SCANPT).EQ."72) GOTO 60
  2813.     PRFLG=0
  2814.     CALL ERROR(205)
  2815.     RETURN
  2816. C
  2817. 60    SCANPT=SCANPT+1
  2818.     PRFLG=1
  2819. 62    IF(SRCLNE(SCANPT).NE."40) GOTO 70
  2820.     SCANPT=SCANPT+1
  2821.     GOTO 62
  2822. C
  2823. 70    IF(SRCLNE(SCANPT).EQ.0) GOTO 12
  2824.     OPPTR=SCANPT
  2825.     DO 80 I=1,5
  2826.     IF(SRCLNE(SCANPT).LT.65.OR.SRCLNE(SCANPT).GT.90) GOTO 90
  2827.     SCANPT=SCANPT+1
  2828. 80    CONTINUE
  2829. C
  2830. C....    LENGTH OF OPCODE IS ONE LESS THAN # SCANNED
  2831. 90    OPCLEN=I-1
  2832. C
  2833. C....    CHECK FOR END OF LINE
  2834.     IF(SRCLNE(SCANPT).EQ.0) RETURN
  2835. C
  2836. C....    CHECK FOR SPACE
  2837.     IF(SRCLNE(SCANPT).EQ."40) GOTO 112
  2838. C
  2839. C....    CHECK FOR xxx.x
  2840.     IF(SRCLNE(SCANPT).EQ."56) GOTO 100
  2841. C
  2842. C....    IF NOT EOL,SPC,OR PERIOD GEN ERROR
  2843. 95    OPPTR=0
  2844.     PRFLG=0
  2845.     CALL ERROR(207)
  2846.     RETURN
  2847. C
  2848. C....    CHECK FOR .B .W .L .S
  2849. C....    POINT TO SIZE SUBFIELD
  2850. 100    SCANPT=SCANPT+1
  2851. C
  2852. C....    SCAN FOR VALID SIZE
  2853.     DO 102,IMODE = 1,4
  2854. 102    IF(MODTBL(IMODE).EQ.SRCLNE(SCANPT))GOTO 105
  2855. C
  2856. C....    IF NOT IN TABLE IT'S INVALID
  2857.     IMODE = 0
  2858.     GOTO 95
  2859. C
  2860. C....    SAVE POSITION OF MODE FIELD
  2861. 105    MODPTR=SCANPT
  2862. C
  2863. C....    CHECK FOR SPACE AFTER OPCODE
  2864. 110    SCANPT=SCANPT+1
  2865.     IF(SRCLNE(SCANPT).NE."40) GOTO 95
  2866. C
  2867. C....    PARSE FIRST OPERAND IF THERE
  2868. 112    SCANPT=SCANPT+1
  2869.     IC=SRCLNE(SCANPT)
  2870.     IF(IC.EQ. 0 ) RETURN
  2871.     IF(IC.EQ."40) GOTO 112
  2872.     IF(IC.EQ."44.OR.IC.EQ."52) GOTO 114
  2873.     IF ((IC.EQ."50).OR.(IC.EQ."47)) GOTO 114
  2874.     IF(IC.EQ."55.OR.IC.EQ."43) GOTO 114
  2875.     IF(IC.GE."60.AND.IC.LE."71) GOTO 114
  2876.     IF(IC.LT."101.OR.IC.GT."132) GOTO 95
  2877. C
  2878. C....    SAVE START OF FIRST OPERAND
  2879. C
  2880. 114    OPNPTR=SCANPT
  2881.     IF ((SRCLNE(SCANPT).NE."47).AND.(SRCLNE(SCANPT+1).NE."47))
  2882.      +     GOTO 116
  2883.     IF (SRCLNE(SCANPT+1).EQ."47) SCANPT = SCANPT + 1
  2884. 115    SCANPT = SCANPT+1
  2885.     IF(SRCLNE(SCANPT).EQ.0) GOTO 118
  2886.     IF(SRCLNE(SCANPT).NE."47) GOTO 115
  2887. 116    SCANPT=SCANPT+1
  2888.     IC=SRCLNE(SCANPT)
  2889.     IF((IC.EQ.0).OR.(IC.EQ."40)) GOTO 118
  2890.     IF(IC.EQ."50) IPF=1
  2891.     IF(IC.EQ."51) IPF=0
  2892.     IF(IC.EQ."54.AND.IPF.EQ.0) GOTO 120
  2893.     GOTO 116
  2894. 118    OPNPT2=0
  2895.     IF (IC.NE."40) RETURN
  2896. 119    SCANPT = SCANPT+1
  2897.     IF (SRCLNE(SCANPT).EQ."40) GOTO 119
  2898.     CMTPTR = SCANPT
  2899.     RETURN
  2900. C
  2901. C....    SAVE START OF SECOND OPERAND
  2902. C
  2903. 120    OPNPT2=SCANPT+1
  2904. 125    SCANPT = SCANPT + 1
  2905.     IF (SRCLNE(SCANPT).EQ."40) GOTO 130
  2906.     IF (SRCLNE(SCANPT).EQ.0  ) RETURN
  2907.     IF (SRCLNE(SCANPT).NE."47) GOTO 125
  2908. 127    SCANPT = SCANPT + 1
  2909.     IF (SRCLNE(SCANPT).EQ.0  ) RETURN
  2910.     IF (SRCLNE(SCANPT).NE."47) GOTO 127
  2911.     GOTO 125
  2912. 130    SCANPT = SCANPT + 1
  2913.     IF (SRCLNE(SCANPT).EQ."40) GOTO 130
  2914.     CMTPTR = SCANPT
  2915.     RETURN
  2916.     END
  2917.